1 (* This program is free software: you can redistribute it and/or modify
2 it under the terms of the GNU General Public License as published by
3 the Free Software Foundation, either version 2, 3 or any later version
4 of the License (at your option).
5
6 This program is distributed in the hope that it will be useful,
7 but WITHOUT ANY WARRANTY; without even the implied warranty of
8 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
9 GNU General Public License for more details.
10
11 You should have received a copy of the GNU General Public License
12 along with this program. If not, see <https://www.gnu.org/licenses/>.
13 *)
14
15 (*
16 settings set target.output-path /tmp/out.txt
17 *)
18 unit LldbDebugger;
19
20 {$mode objfpc}{$H+}
21
22 interface
23
24 uses
25 Classes, SysUtils, strutils, math,
26 // LazUtils
27 LazClasses, LazFileUtils, LazLoggerBase, LazStringUtils, Maps,
28 // DebuggerIntf
29 DbgIntfDebuggerBase, DbgIntfBaseTypes,
30 // CmdLineDebuggerBase
31 DebugProcess,
32 // LazDebuggerLldb
33 LldbInstructions, LldbHelper;
34
35 type
36
37 (*
38 * Commands
39 *)
40
41 TLldbDebugger = class;
42 TLldbDebuggerCommand = class;
43
44 { TLldbDebuggerCommandQueue }
45
46 TLldbDebuggerCommandQueue = class(TRefCntObjList)
47 private
48 FDebugger: TLldbDebugger;
49 FLockQueueRun: Integer;
Getnull50 function Get(Index: Integer): TLldbDebuggerCommand;
51 procedure Put(Index: Integer; const AValue: TLldbDebuggerCommand);
52 private
53 FRunningCommand: TLldbDebuggerCommand;
54 procedure Run; // Call Debugger.OnIdle // set IsIdle
55 protected
56 procedure CommandFinished(ACommand: TLldbDebuggerCommand);
57 public
58 constructor Create(ADebugger: TLldbDebugger);
59 destructor Destroy; override;
60 procedure CancelAll;
61 procedure CancelForRun;
62 procedure LockQueueRun;
63 procedure UnLockQueueRun;
64 property Items[Index: Integer]: TLldbDebuggerCommand read Get write Put; default;
65 procedure QueueCommand(AValue: TLldbDebuggerCommand);
66 procedure DoLineDataReceived(var ALine: String);
67 property RunningCommand: TLldbDebuggerCommand read FRunningCommand;
68 end;
69
70 { TLldbDebuggerCommand }
71
72 TLldbDebuggerCommand = class(TRefCountedObject)
73 private
74 FCancelableForRun: Boolean;
75 FOwner: TLldbDebugger;
76 FIsRunning: Boolean;
GetDebuggerStatenull77 function GetDebuggerState: TDBGState;
GetCommandQueuenull78 function GetCommandQueue: TLldbDebuggerCommandQueue;
GetInstructionQueuenull79 function GetInstructionQueue: TLldbInstructionQueue;
80 protected
81 procedure DoLineDataReceived(var ALine: String); virtual;
82 procedure DoExecute; virtual; abstract;
83 procedure DoCancel; virtual;
84 procedure Finished;
85
86 procedure InstructionSucceeded(AnInstruction: TObject);
87 procedure InstructionFailed(AnInstruction: TObject);
88
89 procedure QueueInstruction(AnInstruction: TLldbInstruction);
90 procedure SetDebuggerState(const AValue: TDBGState);
91 property Debugger: TLldbDebugger read FOwner;
92 property CommandQueue: TLldbDebuggerCommandQueue read GetCommandQueue;
93 property InstructionQueue: TLldbInstructionQueue read GetInstructionQueue;
94 property DebuggerState: TDBGState read GetDebuggerState;
95 public
96 constructor Create(AOwner: TLldbDebugger);
97 destructor Destroy; override;
98 procedure Execute;
99 procedure Cancel;
100 property CancelableForRun: Boolean read FCancelableForRun write FCancelableForRun;
101 end;
102
103 { TLldbDebuggerCommandInit }
104
105 TLldbDebuggerCommandInit = class(TLldbDebuggerCommand)
106 private
107 FGotLLDB: Boolean;
108 protected
109 procedure DoExecute; override;
110 procedure DoLineDataReceived(var ALine: String); override;
111 end;
112
113 { TLldbDebuggerCommandRun }
114
115 TLldbDebuggerCommandRun = class(TLldbDebuggerCommand)
116 private type
117 TExceptionInfoCommand = (exiReg0, exiReg2, exiClass, exiMsg);
118 TExceptionInfoCommands = set of TExceptionInfoCommand;
119 private
120 FMode: (cmRun, cmRunToCatch, cmRunAfterCatch, cmRunToTmpBrk);
121 FState: (crRunning, crReadingThreads, crStopped, crStoppedRaise, crDone);
122 FNextStepAction: TLldbInstructionProcessStepAction;
123 FWaitToResume: Boolean;
124 FCurBrkId, FTmpBreakId: Integer;
125 FUnknownStopReason: String;
126 FThreadInstr: TLldbInstructionThreadList;
127 FCurrentExceptionInfo: record
128 FHasCommandData: TExceptionInfoCommands; // cleared in Setstate
129 FObjAddress, FFramePtr: TDBGPtr;
130 FExceptClass: String;
131 FExceptMsg: String;
132 end;
133 FFramePtrAtStart: TDBGPtr;
134 FFramesDescending: Boolean;
135 procedure ThreadInstructionSucceeded(Sender: TObject);
136 procedure ExceptionReadReg0Success(Sender: TObject);
137 procedure ExceptionReadReg2Success(Sender: TObject);
138 procedure ExceptionReadClassSuccess(Sender: TObject);
139 procedure ExceptionReadMsgSuccess(Sender: TObject);
140 procedure CatchesStackInstructionFinished(Sender: TObject);
141 procedure SearchFpStackInstructionFinished(Sender: TObject);
142 procedure SearchExceptFpStackInstructionFinished(Sender: TObject);
143 procedure TempBreakPointSet(Sender: TObject);
144 procedure RunInstructionSucceeded(AnInstruction: TObject);
145 procedure ResetStateToRun;
146 procedure SetNextStepCommand(AStepAction: TLldbInstructionProcessStepAction);
147 procedure ResumeWithNextStepCommand;
148 procedure SetTempBreakPoint(AnAddr: TDBGPtr);
149 procedure DeleteTempBreakPoint;
150 Procedure SetDebuggerLocation(AnAddr, AFrame: TDBGPtr; AFuncName, AFile, AFullFile: String; SrcLine: integer);
151 protected
152 FStepAction: TLldbInstructionProcessStepAction;
153 procedure DoLineDataReceived(var ALine: String); override;
154 procedure DoCancel; override;
155 procedure DoInitialExecute; virtual; abstract;
156 procedure DoExecute; override;
157 public
158 constructor Create(AOwner: TLldbDebugger);
159 destructor Destroy; override;
160 end;
161
162 { TLldbDebuggerCommandRunStep }
163
164 TLldbDebuggerCommandRunStep = class(TLldbDebuggerCommandRun)
165 private
166 protected
167 procedure DoInitialExecute; override;
168 public
169 constructor Create(AOwner: TLldbDebugger; AStepAction: TLldbInstructionProcessStepAction);
170 end;
171
172 { TLldbDebuggerCommandRunLaunch }
173
174 TLldbDebuggerCommandRunLaunch = class(TLldbDebuggerCommandRun)
175 private
176 FRunInstr: TLldbInstruction;
177 FLaunchWarnings: String;
178 procedure CollectDwarfLoadErrors(Sender: TObject);
179 procedure ExceptBreakInstructionFinished(Sender: TObject);
180 procedure LaunchInstructionSucceeded(Sender: TObject);
181 procedure TargetCreated(Sender: TObject);
182 protected
183 procedure DoInitialExecute; override;
184 constructor Create(AOwner: TLldbDebugger);
185 end;
186
187 { TLldbDebuggerCommandStop }
188
189 TLldbDebuggerCommandStop = class(TLldbDebuggerCommand)
190 private
191 procedure StopInstructionSucceeded(Sender: TObject);
192 protected
193 procedure DoExecute; override;
194 end;
195
196 { TLldbDebuggerCommandLocals }
197
198 TLldbDebuggerCommandLocals = class(TLldbDebuggerCommand)
199 private
200 FLocals: TLocals;
201 FLocalsInstr: TLldbInstructionLocals;
202 procedure DoLocalsFreed(Sender: TObject);
203 procedure LocalsInstructionFinished(Sender: TObject);
204 protected
205 procedure DoExecute; override;
206 public
207 constructor Create(AOwner: TLldbDebugger; ALocals: TLocals);
208 destructor Destroy; override;
209 end;
210
211 { TLldbDebuggerCommandEvaluate }
212
213 TLldbDebuggerCommandEvaluate = class(TLldbDebuggerCommand)
214 private
215 FInstr: TLldbInstructionExpression;
216 FWatchValue: TWatchValue;
217 FExpr: String;
218 FFlags: TDBGEvaluateFlags;
219 FCallback: TDBGEvaluateResultCallback;
220 procedure DoWatchFreed(Sender: TObject);
221 procedure EvalInstructionFailed(Sender: TObject);
222 procedure EvalInstructionSucceeded(Sender: TObject);
223 protected
224 procedure DoExecute; override;
225 public
226 // TODO: Pass FCurrentStackFrame to create
227 constructor Create(AOwner: TLldbDebugger; AWatchValue: TWatchValue);
228 constructor Create(AOwner: TLldbDebugger; AnExpr: String; AFlags: TDBGEvaluateFlags;
229 ACallback: TDBGEvaluateResultCallback);
230 destructor Destroy; override;
231 end;
232
233
234 { TlldbInternalBreakPoint }
235
236 TlldbInternalBreakPoint = class
237 private
238 FDwarfLoadErrors: String;
239 FName: String;
240 FBeforePrologue: Boolean;
241 FId: Integer;
242 FDebugger: TLldbDebugger;
243 FOnFail: TNotifyEvent;
244 FOnFinish: TNotifyEvent;
245 procedure BreakSetSuccess(Sender: TObject);
246 procedure DoFailed(Sender: TObject);
247 procedure DoFinished(Sender: TObject);
248 procedure QueueInstruction(AnInstr: TLldbInstruction);
249 public
250 constructor Create(AName: String; ADebugger: TLldbDebugger; ABeforePrologue: Boolean = False);
251 destructor Destroy; override;
252 procedure Enable;
253 procedure Disable;
254 procedure Remove;
255 property BreakId: Integer read FId;
256 property OnFail: TNotifyEvent read FOnFail write FOnFail;
257 property OnFinish: TNotifyEvent read FOnFinish write FOnFinish;
258 property DwarfLoadErrors: String read FDwarfLoadErrors;
259 end;
260
261 { TLldbDebuggerCommandRegister }
262
263 TLldbDebuggerCommandRegister = class(TLldbDebuggerCommand)
264 private
265 FRegisters: TRegisters;
266 procedure RegisterInstructionFinished(Sender: TObject);
267 protected
268 procedure DoExecute; override;
269 procedure DoCancel; override;
270 public
271 constructor Create(AOwner: TLldbDebugger; ARegisters: TRegisters);
272 destructor Destroy; override;
273 property Registers: TRegisters read FRegisters;
274 end;
275
276 (*
277 * Debugger
278 *)
279 { TLldbDebugger }
280
281 { TLldbDebuggerProperties }
282
283 TLldbDebuggerProperties = class(TDebuggerProperties)
284 private
285 FLaunchNewTerminal: Boolean;
286 FSkipGDBDetection: Boolean;
287 FIgnoreLaunchWarnings: Boolean;
288 public
289 constructor Create; override;
290 procedure Assign(Source: TPersistent); override;
291 published
292 property LaunchNewTerminal: Boolean read FLaunchNewTerminal write FLaunchNewTerminal default False;
293 property SkipGDBDetection: Boolean read FSkipGDBDetection write FSkipGDBDetection default False;
294 property IgnoreLaunchWarnings: Boolean read FIgnoreLaunchWarnings write FIgnoreLaunchWarnings default False;
295 end;
296
297 TLldbDebugger = class(TDebuggerIntf)
298 private
299 FDebugProcess: TDebugProcess;
300 FDebugInstructionQueue: TLldbInstructionQueue;
301 FCommandQueue: TLldbDebuggerCommandQueue;
302 FInIdle: Boolean;
303 FCurrentLocation: TDBGLocationRec;
304 FCurrentStackFrame: Integer;
305 FCurrentThreadId: Integer;
306 FCurrentThreadFramePtr: TDBGPtr;
307 FBreakErrorBreak: TlldbInternalBreakPoint;
308 FRunErrorBreak: TlldbInternalBreakPoint;
309 FExceptionBreak: TlldbInternalBreakPoint;
310 FPopExceptStack, FCatchesBreak, FReRaiseBreak: TlldbInternalBreakPoint;
311 FTargetWidth: Byte;
312 FTargetRegisters: array[0..2] of String;
313 FLldbMissingBreakSetDisable: Boolean;
314 FExceptionInfo: record
315 FReg0Cmd, FReg2Cmd, FExceptClassCmd, FExceptMsgCmd: String;
316 FAtExcepiton: Boolean; // cleared in Setstate
317 end;
318 (* DoAfterLineReceived is called after DebugInstruction.ProcessInputFromDbg
319 (but not if ProcessInputFromDbg already handled the Line)
320 DoAfterLineReceived will first call CommandQueue.DoLineDataReceived
321 *)
322 procedure DoAfterLineReceived(var ALine: String); //
323 procedure DoBeforeLineReceived(var ALine: String); // Before DebugInstruction.ProcessInputFromDbg
324 procedure DoCmdLineDebuggerTerminated(Sender: TObject);
325 procedure DoLineSentToDbg(Sender: TObject; ALine: String);
326
LldbRunnull327 function LldbRun: Boolean;
LldbStepnull328 function LldbStep(AStepAction: TLldbInstructionProcessStepAction): Boolean;
LldbStopnull329 function LldbStop: Boolean;
LldbPausenull330 function LldbPause: Boolean;
LldbEvaluatenull331 function LldbEvaluate(const AExpression: String; EvalFlags: TDBGEvaluateFlags; ACallback: TDBGEvaluateResultCallback): Boolean;
LldbEnvironmentnull332 function LldbEnvironment(const AVariable: String; const ASet: Boolean): Boolean;
333 procedure TerminateLldb; // Kills external debugger
334 protected
335 procedure DoBeforeLaunch; virtual;
336 procedure DoAfterLaunch(var LaunchWarnings: string); virtual;
337 procedure DoBeginReceivingLines(Sender: TObject);
338 procedure DoEndReceivingLines(Sender: TObject);
339 procedure LockRelease; override;
340 procedure UnlockRelease; override;
341 procedure QueueCommand(const ACommand: TLldbDebuggerCommand);
342 procedure DoState(const OldState: TDBGState); override;
343 //procedure DoBeforeState(const OldState: TDBGState); override;
344 procedure SetErrorState(const AMsg: String; const AInfo: String = '');
DoExceptionHitnull345 function DoExceptionHit(AExcClass, AExcMsg: String): Boolean;
DoBreakpointHitnull346 function DoBreakpointHit(BrkId: Integer): Boolean;
347
348 property CurrentThreadId: Integer read FCurrentThreadId;
349 property CurrentStackFrame: Integer read FCurrentStackFrame;
350 property CurrentLocation: TDBGLocationRec read FCurrentLocation;
351 property DebugInstructionQueue: TLldbInstructionQueue read FDebugInstructionQueue;
352 property CommandQueue: TLldbDebuggerCommandQueue read FCommandQueue;
353 protected
CreateBreakPointsnull354 function CreateBreakPoints: TDBGBreakPoints; override;
CreateLocalsnull355 function CreateLocals: TLocalsSupplier; override;
CreateLineInfonull356 //function CreateLineInfo: TDBGLineInfo; override;
357 function CreateRegisters: TRegisterSupplier; override;
CreateCallStacknull358 function CreateCallStack: TCallStackSupplier; override;
CreateDisassemblernull359 //function CreateDisassembler: TDBGDisassembler; override;
360 function CreateWatches: TWatchesSupplier; override;
CreateThreadsnull361 function CreateThreads: TThreadsSupplier; override;
GetTargetWidthnull362 function GetTargetWidth: Byte; override;
363
GetIsIdlenull364 function GetIsIdle: Boolean; override;
GetSupportedCommandsnull365 class function GetSupportedCommands: TDBGCommands; override;
GetCommandsnull366 //function GetCommands: TDBGCommands; override;
367 function RequestCommand(const ACommand: TDBGCommand;
368 const AParams: array of const;
369 const ACallback: TMethod): Boolean; override;
370 public
CreatePropertiesnull371 class function CreateProperties: TDebuggerProperties; override; // Creates debuggerproperties
Captionnull372 class function Caption: String; override;
ExePathsnull373 class function ExePaths: String; override;
ExePathsMruGroupnull374 class function ExePathsMruGroup: TDebuggerClass; override;
375
376 constructor Create(const AExternalDebugger: String); override;
377 destructor Destroy; override;
378 procedure Init; override; // Initializes external debugger
379 procedure Done; override; // Kills external debugger
380
RequiredCompilerOptsnull381 class function RequiredCompilerOpts(ATargetCPU, ATargetOS: String
382 ): TDebugCompilerRequirements; override;
GetLocationnull383 function GetLocation: TDBGLocationRec; override;
GetProcessListnull384 // function GetProcessList({%H-}AList: TRunningProcessInfoList): boolean; override;
385 function NeedReset: Boolean; override;
386 procedure TestCmd(const ACommand: String); override;
387 end;
388
389
390 procedure Register;
391
392 implementation
393
394 var
395 DBG_VERBOSE: PLazLoggerLogGroup;
396
397 type
398
399 {%region
400 *****
401 ***** Threads
402 ***** }
403
404 { TLldbDebuggerCommandThreads }
405
406 TLldbDebuggerCommandThreads = class(TLldbDebuggerCommand)
407 private
408 procedure ThreadInstructionSucceeded(Sender: TObject);
409 protected
410 constructor Create(AOwner: TLldbDebugger);
411 procedure DoExecute; override;
412 end;
413
414 { TLldbThreads }
415
416 TLldbThreads = class(TThreadsSupplier)
417 private
418 FThreadFramePointers: Array of TDBGPtr;
GetDebuggernull419 function GetDebugger: TLldbDebugger;
420 protected
421 procedure DoStateEnterPause; override;
422 procedure ReadFromThreadInstruction(Instr: TLldbInstructionThreadList; ACurrentId: Integer = -1);
423 public
424 procedure RequestMasterData; override;
425 procedure ChangeCurrentThread(ANewId: Integer); override;
GetFramePointerForThreadnull426 function GetFramePointerForThread(AnId: Integer): TDBGPtr;
427 property Debugger: TLldbDebugger read GetDebugger;
428 end;
429
430 {%endregion ^^^^^ Threads ^^^^^ }
431
432 {%region
433 *****
434 ***** CallStack
435 ***** }
436
437 { TLldbDebuggerCommandCallStack }
438
439 TLldbDebuggerCommandCallStack = class(TLldbDebuggerCommand)
440 private
441 FCurrentCallStack: TCallStackBase;
442 procedure DoCallstackFreed(Sender: TObject);
443 procedure StackInstructionFinished(Sender: TObject);
444 protected
445 procedure DoExecute; override;
446 public
447 constructor Create(AOwner: TLldbDebugger; ACurrentCallStack: TCallStackBase);
448 destructor Destroy; override;
449 property CurrentCallStack: TCallStackBase read FCurrentCallStack;
450 end;
451
452 { TLldbCallStack }
453
454 TLldbCallStack = class(TCallStackSupplier)
455 protected
456 //procedure Clear;
457 procedure DoThreadChanged;
458 procedure ParentRequestEntries(ACallstack: TCallStackBase);
459 public
460 procedure RequestAtLeastCount(ACallstack: TCallStackBase;
461 ARequiredMinCount: Integer); override;
462 procedure UpdateCurrentIndex; override;
463 procedure RequestCurrent(ACallstack: TCallStackBase); override;
464 procedure RequestEntries(ACallstack: TCallStackBase); override;
465 end;
466
467 {%endregion ^^^^^ CallStack ^^^^^ }
468
469 {%region
470 *****
471 ***** Locals
472 ***** }
473
474 { TLldbLocals }
475
476 TLldbLocals = class(TLocalsSupplier)
477 public
478 procedure RequestData(ALocals: TLocals); override;
479 end;
480
481 {%endregion ^^^^^ Locals ^^^^^ }
482
483 {%region
484 *****
485 ***** Watches
486 ***** }
487
488 { TLldbWatches }
489
490 TLldbWatches = class(TWatchesSupplier)
491 private
492 protected
493 procedure InternalRequestData(AWatchValue: TWatchValue); override;
494 public
495 end;
496
497 {%endregion ^^^^^ Watches ^^^^^ }
498
499 {%region
500 *****
501 ***** BreakPoint
502 ***** }
503
504 { TLldbBreakPoint }
505
506 TLldbBreakPoint = class(TDBGBreakPoint)
507 private
508 FBreakID: Integer;
509 FCurrentInstruction: TLldbInstruction;
510 FNeededChanges: TDbgBpChangeIndicators;
511 procedure InstructionSetBreakFinished(Sender: TObject);
512 procedure InstructionUpdateBreakFinished(Sender: TObject);
513 procedure SetBreakPoint;
514 procedure ReleaseBreakPoint;
515 procedure UpdateProperties(AChanged: TDbgBpChangeIndicators);
516 procedure DoCurrentInstructionFinished;
517 procedure CancelCurrentInstruction;
518 protected
519 procedure DoStateChange(const AOldState: TDBGState); override;
520 procedure DoPropertiesChanged(AChanged: TDbgBpChangeIndicators); override;
521 public
522 // constructor Create(ACollection: TCollection); override;
523 destructor Destroy; override;
524 // procedure DoLogExpression(const AnExpression: String); override;
525 end;
526
527 { TLldbBreakPoints }
528
529 TLldbBreakPoints = class(TDBGBreakPoints)
530 protected
FindByIdnull531 function FindById(AnId: Integer): TLldbBreakPoint;
532 end;
533
534 {%endregion ^^^^^ BreakPoint ^^^^^ }
535
536 {%region
537 *****
538 ***** Register
539 ***** }
540
541 { TLldbRegisterSupplier }
542
543 TLldbRegisterSupplier = class(TRegisterSupplier)
544 public
545 procedure Changed;
546 procedure RequestData(ARegisters: TRegisters); override;
547 end;
548
549 { TLldbDebuggerProperties }
550
551 constructor TLldbDebuggerProperties.Create;
552 begin
553 inherited Create;
554 FLaunchNewTerminal := False;
555 FSkipGDBDetection := False;
556 FIgnoreLaunchWarnings := False;
557 end;
558
559 procedure TLldbDebuggerProperties.Assign(Source: TPersistent);
560 begin
561 inherited Assign(Source);
562 if Source is TLldbDebuggerProperties then begin
563 FLaunchNewTerminal := TLldbDebuggerProperties(Source).FLaunchNewTerminal;
564 FSkipGDBDetection := TLldbDebuggerProperties(Source).FSkipGDBDetection;
565 FIgnoreLaunchWarnings := TLldbDebuggerProperties(Source).FIgnoreLaunchWarnings;
566 end;
567 end;
568
569 { TLldbDebuggerCommandRun }
570
571 procedure TLldbDebuggerCommandRun.CatchesStackInstructionFinished(Sender: TObject);
572 var
573 Instr: TLldbInstruction;
574 r: TStringArray;
575 Id, line: Integer;
576 IsCur: Boolean;
577 addr, stack, frame: TDBGPtr;
578 func, filename, fullfile, d: String;
579 Arguments: TStringList;
580 begin
581 r := TLldbInstructionStackTrace(Sender).Res;
582 if Length(r) < 1 then begin
583 SetDebuggerState(dsPause);
584 Finished;
585 exit;
586 end;
587
588 ParseNewFrameLocation(r[0], Id, IsCur, addr, stack, frame, func, Arguments, filename, fullfile, line, d);
589 Arguments.Free;
590 if addr = 0 then begin
591 SetDebuggerState(dsPause);
592 Finished;
593 exit;
594 end;
595
596 if FMode = cmRunToTmpBrk then begin
597 if (FFramesDescending and (frame > FFramePtrAtStart)) or
598 ((not FFramesDescending) and (frame < FFramePtrAtStart))
599 then begin
600 ResetStateToRun;
601 SetNextStepCommand(saContinue);
602 exit;
603 end;
604 DeleteTempBreakPoint; // except stepped out below temp brkpoint
605 end;
606
607
608 SetTempBreakPoint(Addr);
609 ResetStateToRun;
610 FMode := cmRunAfterCatch;
611 SetNextStepCommand(saContinue);
612 end;
613
614 procedure TLldbDebuggerCommandRun.TempBreakPointSet(Sender: TObject);
615 begin
616 FTmpBreakId := TLldbInstructionBreakSet(Sender).BreakId;
617 end;
618
619 procedure TLldbDebuggerCommandRun.SearchFpStackInstructionFinished(
620 Sender: TObject);
621 var
622 r: TStringArray;
623 fr: Integer;
624 Id, line: Integer;
625 IsCur: Boolean;
626 addr, stack, frame, prev: TDBGPtr;
627 func, filename, fullfile, d: String;
628 Arguments: TStringList;
629 begin
630 r := TLldbInstructionStackTrace(Sender).Res;
631 if Length(r) < 1 then begin
632 SetDebuggerState(dsPause);
633 Finished;
634 exit;
635 end;
636
637 fr := 0;
638 prev := 0;
639 repeat
640 ParseNewFrameLocation(r[fr], Id, IsCur, addr, stack, frame, func, Arguments, filename, fullfile, line, d);
641 Arguments.Free;
642
643 if fr = 0 then begin
644 FFramesDescending := frame > FFramePtrAtStart;
645 if (FState = crStoppedRaise) and (Length(r) >= 2) then begin
646 inc(fr);
647 Continue;
648 end;
649 end;
650
651 if not( (frame = 0) or ((fr > 0) and (frame = {%H-}prev)) ) then begin
652
653 if frame = FFramePtrAtStart then
654 break;
655
656 if (prev <> 0) and (
657 ( (fr < prev) and not(FFramePtrAtStart < fr) ) or
658 ( (fr > prev) and not(FFramePtrAtStart > fr) )
659 )
660 then begin
661 SetDebuggerState(dsPause);
662 Finished;
663 exit;
664 end;
665
666 prev := frame;
667 end;
668 inc(fr);
669 until fr >= Length(r);
670
671 if (fr >= Length(r)) or (addr = 0) then begin
672 SetDebuggerState(dsPause);
673 Finished;
674 exit;
675 end;
676
677 SetTempBreakPoint(Addr);
678 ResetStateToRun;
679 FMode := cmRunToTmpBrk;
680 SetNextStepCommand(saContinue);
681 end;
682
683 procedure TLldbDebuggerCommandRun.SearchExceptFpStackInstructionFinished(
684 Sender: TObject);
685 var
686 r: TStringArray;
687 fr: Integer;
688 Id, line: Integer;
689 IsCur: Boolean;
690 addr, stack, frame: TDBGPtr;
691 func, filename, fullfile, d: String;
692 Arguments: TStringList;
693 begin
694 r := TLldbInstructionStackTrace(Sender).Res;
695 if Length(r) < 2 then begin
696 SetDebuggerState(dsPause);
697 Finished;
698 exit;
699 end;
700
701 fr := 1;
702 repeat
703 ParseNewFrameLocation(r[fr], Id, IsCur, addr, stack, frame, func, Arguments, filename, fullfile, line, d);
704 Arguments.Free;
705
706 if frame = FCurrentExceptionInfo.FFramePtr then begin
707 SetDebuggerLocation(Addr, Frame, Func, filename, FullFile, Line);
708 break;
709 end;
710
711 inc(fr);
712 until fr >= Length(r);
713
714 SetDebuggerState(dsPause);
715 Debugger.DoCurrent(Debugger.FCurrentLocation);
716 Finished;
717 end;
718
719 procedure TLldbDebuggerCommandRun.ThreadInstructionSucceeded(Sender: TObject);
720 begin
721 FState := crStopped;
722 end;
723
724 procedure TLldbDebuggerCommandRun.ExceptionReadReg0Success(Sender: TObject);
725 var
726 v: String;
727 i: SizeInt;
728 begin
729 v := TLldbInstructionReadExpression(Sender).Res;
730 i := pos(' = ', v);
731 if i > 1 then
732 delete(v, 1, i+2);
733 FCurrentExceptionInfo.FObjAddress := StrToInt64Def(v, 0);
734 Include(FCurrentExceptionInfo.FHasCommandData, exiReg0);
735 end;
736
737 procedure TLldbDebuggerCommandRun.ExceptionReadReg2Success(Sender: TObject);
738 var
739 v: String;
740 i: SizeInt;
741 begin
742 v := TLldbInstructionReadExpression(Sender).Res;
743 i := pos(' = ', v);
744 if i > 1 then
745 delete(v, 1, i+2);
746 FCurrentExceptionInfo.FFramePtr := StrToInt64Def(v, 0);
747 Include(FCurrentExceptionInfo.FHasCommandData, exiReg2);
748 end;
749
750 procedure TLldbDebuggerCommandRun.ExceptionReadClassSuccess(Sender: TObject);
751 var
752 s: String;
753 i: SizeInt;
754 l: Integer;
755 begin
756 // (char * ) $2 = 0x005c18d0 "\tException"
757 // (char *) $10 = 0x00652d44 "\x04TXXX"
758 s := TLldbInstructionReadExpression(Sender).Res;
759 i := pos('"', s);
760 l := 255;
761 if i > 0 then begin
762 if s[i+1] = '\' then begin
763 inc(i, 2);
764 if s[i] = 'x' then begin
765 l := StrToIntDef('$'+copy(s, i+1, 2), 255);
766 inc(i, 2);
767 end
768 else begin
769 case s[i] of
770 'a': l := 7;
771 'b': l := 8;
772 't': l := 9;
773 'n': l := 10;
774 'v': l := 11;
775 'f': l := 12;
776 'r': l := 13;
777 'e': l := 27;
778 's': l := 32;
779 '\': l := 92;
780 'd': l := 127;
781 end;
782 end;
783 end
784 else begin
785 inc(i, 1);
786 l := ord(s[i]);
787 end;
788 s := copy(s, i+1, Min(l, Length(s)-i-1));
789 end;
790 FCurrentExceptionInfo.FExceptClass := s;
791 Include(FCurrentExceptionInfo.FHasCommandData, exiClass);
792 end;
793
794 procedure TLldbDebuggerCommandRun.ExceptionReadMsgSuccess(Sender: TObject);
795 var
796 s: String;
797 i: SizeInt;
798 begin
799 s := TLldbInstructionReadExpression(Sender).Res;
800 i := pos('"', s);
801 if i > 0 then
802 s := copy(s, i+1, Length(s)-i-1);
803 FCurrentExceptionInfo.FExceptMsg := s;
804 Include(FCurrentExceptionInfo.FHasCommandData, exiMsg);
805 end;
806
807 procedure TLldbDebuggerCommandRun.DoLineDataReceived(var ALine: String);
808 const
809 MaxStackSearch = 99;
810
811 procedure ContinueRunning;
812 var
813 Instr: TLldbInstruction;
814 begin
815 if FStepAction = saContinue then begin
816 DeleteTempBreakPoint;
817 ResetStateToRun;
818 FMode := cmRun;
819 SetNextStepCommand(saContinue);
820 exit;
821 end;
822
823 if FFramePtrAtStart = 0 then begin
824 SetDebuggerState(dsPause);
825 Finished;
826 exit;
827 end;
828
829 if FTmpBreakId = 0 then begin
830 FMode := cmRunToTmpBrk;
831 FState := crRunning; // Ignore the STEP 3 / frame
832 Instr := TLldbInstructionStackTrace.Create(MaxStackSearch, 0, Debugger.FCurrentThreadId);
833 Instr.OnFinish := @SearchFpStackInstructionFinished;
834 QueueInstruction(Instr);
835 Instr.ReleaseReference;
836 exit;
837 end;
838
839 ResetStateToRun;
840 FMode := cmRunToTmpBrk;
841 SetNextStepCommand(saContinue);
842
843 //case FStepAction of
844 // saInsIn: SetDebuggerState(dsPause);
845 // saInsOver, saOver: ;
846 // saInto: ;
847 // saOut: ;
848 //end;
849 end;
850
GetBreakPointIdnull851 function GetBreakPointId(AReason: String): Integer;
852 var
853 i: Integer;
854 begin
855 i := pos('.', AReason);
856 if i = 0 then i := Length(AReason)+1;
857 Result := StrToIntDef(copy(AReason, 12, i-12), -1);
858 debugln(DBG_VERBOSE, ['DoBreakPointHit ', AReason, ' / ', Result]);
859 end;
860
861 procedure DoException;
862 var
863 ExcClass, ExcMsg: String;
864 CanContinue: Boolean;
865 Instr: TLldbInstructionStackTrace;
866 ExceptItem: TBaseException;
867 begin
868 if exiClass in FCurrentExceptionInfo.FHasCommandData then
869 ExcClass := FCurrentExceptionInfo.FExceptClass
870 else
871 ExcClass := '<Unknown Class>'; // TODO: move to IDE
872 if exiMsg in FCurrentExceptionInfo.FHasCommandData then
873 ExcMsg := FCurrentExceptionInfo.FExceptMsg
874 else
875 ExcMsg := '<Unknown Message>'; // TODO: move to IDE
876
877 ExceptItem := Debugger.Exceptions.Find(ExcClass);
878 if (ExceptItem <> nil) and (ExceptItem.Enabled)
879 then begin
880 FState := crStoppedRaise;
881 ContinueRunning;
882 exit;
883 end;
884
885 CanContinue := Debugger.DoExceptionHit(ExcClass, ExcMsg);
886
887 if CanContinue then begin
888 FState := crStoppedRaise;
889 ContinueRunning;
890 exit;
891 end
892 else begin
893 Debugger.FExceptionInfo.FAtExcepiton := True;
894
895 if (exiReg2 in FCurrentExceptionInfo.FHasCommandData) and (FCurrentExceptionInfo.FFramePtr <> 0) then begin
896 FState := crRunning; // ensure command is not finished early
897 Instr := TLldbInstructionStackTrace.Create(MaxStackSearch, 0, Debugger.FCurrentThreadId);
898 Instr.OnFinish := @SearchExceptFpStackInstructionFinished;
899 QueueInstruction(Instr);
900 Instr.ReleaseReference;
901 exit;
902 end;
903
904 Debugger.FCurrentLocation.SrcLine := -1;
905 SetDebuggerState(dsPause); // after GetLocation => dsPause may run stack, watches etc
906 end;
907 end;
908
909 procedure DoRunError;
910 var
911 CanContinue: Boolean;
912 ErrNo: Integer;
913 ExceptName: String;
914 ExceptItem: TBaseException;
915 begin
916 ErrNo := 0;
917 if exiReg0 in FCurrentExceptionInfo.FHasCommandData then
918 ErrNo := FCurrentExceptionInfo.FObjAddress;
919 ErrNo := ErrNo and $FFFF;
920
921 ExceptName := Format('RunError(%d)', [ErrNo]);
922 ExceptItem := Debugger.Exceptions.Find(ExceptName);
923 if (ExceptItem <> nil) and (ExceptItem.Enabled)
924 then begin
925 FState := crStoppedRaise;
926 ContinueRunning;
927 exit;
928 end;
929
930 Debugger.DoException(deRunError, ExceptName, Debugger.FCurrentLocation, Debugger.RunErrorText[ErrNo], CanContinue);
931 if CanContinue
932 then begin
933 FState := crStoppedRaise;
934 ContinueRunning;
935 exit;
936 end;
937
938 SetDebuggerState(dsPause); // after GetLocation => dsPause may run stack, watches etc
939 end;
940
941 procedure DoUnknownStopReason(AStopReason: String);
942 var
943 CanContinue: Boolean;
944 begin
945 Debugger.DoException(deExternal, Format('Debugger stopped with reason: %s', [AStopReason]), Debugger.FCurrentLocation, '', CanContinue);
946
947 SetDebuggerState(dsPause); // after GetLocation => dsPause may run stack, watches etc
948 end;
949
950 procedure DoCatchesHit;
951 var
952 Instr: TLldbInstruction;
953 begin
954 FState := crRunning; // Ignore the STEP 3 / frame
955 Instr := TLldbInstructionStackTrace.Create(1, 1, Debugger.FCurrentThreadId);
956 Instr.OnFinish := @CatchesStackInstructionFinished;
957 QueueInstruction(Instr);
958 Instr.ReleaseReference;
959 end;
960
961 procedure DoStopTemp;
962 begin
963 if (FMode in [cmRunAfterCatch, cmRunToTmpBrk]) and (Debugger.FCurrentLocation.SrcLine = 0) then begin
964 DeleteTempBreakPoint;
965 ResetStateToRun;
966 FMode := cmRun;
967 SetNextStepCommand(saOver);
968 exit;
969 end;
970
971 SetDebuggerState(dsPause);
972 end;
973
974 procedure DoBreakPointHit(BrkId: Integer);
975 var
976 BreakPoint: TLldbBreakPoint;
977 CanContinue: Boolean;
978 begin
979 CanContinue := Debugger.DoBreakpointHit(BrkId);
980
981 if CanContinue
982 then begin
983 // Important trigger State => as snapshot is taken in TDebugManager.DebuggerChangeState
984 SetDebuggerState(dsInternalPause); // TODO: need location?
985 ContinueRunning;
986 end
987 else begin
988 SetDebuggerState(dsPause);
989 end;
990 end;
991
992 var
993 Instr: TLldbInstruction;
994 found: TStringArray;
995 AnId, SrcLine, i: Integer;
996 AnIsCurrent: Boolean;
997 AnAddr, stack, frame: TDBGPtr;
998 AFuncName, AFile, AReminder, AFullFile, s, Name: String;
999 AnArgs: TStringList;
1000 begin
1001 (* When the debuggee stops (pause), the following will be received:
1002 // for EXCEPTIONS ONLY (less the spaces between * ) )
1003 p/x $eax
1004 (unsigned int) $1 = 0x04dfd920
1005 p ((char *** )$eax)[0][3]
1006 (char * ) $2 = 0x005c18d0 "\tException"
1007 p ((char ** )$eax)[1]
1008 (char * ) $3 = 0x00000000 <no value available>
1009
1010 // Hit breakpoint
1011 Process 10992 stopped
1012 // thread list => but thread ID may be wrong (maybe look for "reason", instead of leading *
1013 * thread #1: tid=0x1644: 0x00409e91, 0x0158FF38, 0x0158FF50 &&//FULL: \FPC\SVN\fixes_3_0\rtl\win32\..\inc\except.inc &&//SHORT: except.inc &&//LINE: 185 &&//MOD: project1.exe &&//FUNC: fpc_raiseexception(OBJ=0x038f5a90, ANADDR=0x00401601, AFRAME=0x0158ff58) <<&&//FRAME"
1014 thread #2: tid=0x27bc: 0x77abf8dc, 0x0557FE64, 0x0557FEC8 &&//FULL: &&//SHORT: &&//LINE: &&//MOD: ntdll.dll &&//FUNC: NtDelayExecution <<&&//FRAME"
1015 Process 10992 stopped
1016 // thread (correct) and frame
1017 * thread #1, stop reason = breakpoint 6.1
1018 frame #0: 0x0042b855 &&//FULL: \tmp\New Folder (2)\unit1.pas &&//SHORT: unit1.pas &&//LINE: 54 &&//MOD: project1.exe &&//FUNC: FORMCREATE(this=0x04c81248, SENDER=0x04c81248) <<&&//FRAME
1019 ... stop reason = Exception 0xc0000005 encountered at address 0x42e067
1020 ... stop reason = EXC_BAD_ACCESS (code=1, address=0x4)
1021 ... stop reason = step over
1022 ... stop reason = step in
1023 ... stop reason = instruction step over
1024 ... google stop reason = signal / trace / watchpoint
1025 *)
1026
1027 {%region exception }
1028 s := TrimLeft(ALine);
1029 Instr := nil;
1030 if StrStartsWith(s, Debugger.FExceptionInfo.FReg0Cmd, True) then begin
1031 Instr := TLldbInstructionReadExpression.Create;
1032 Instr.OnSuccess := @ExceptionReadReg0Success;
1033 end
1034 else
1035 if StrStartsWith(s, Debugger.FExceptionInfo.FReg2Cmd, True) then begin
1036 Instr := TLldbInstructionReadExpression.Create;
1037 Instr.OnSuccess := @ExceptionReadReg2Success;
1038 end
1039 else
1040 if StrStartsWith(s, Debugger.FExceptionInfo.FExceptClassCmd, True) then begin
1041 Instr := TLldbInstructionReadExpression.Create;
1042 Instr.OnSuccess := @ExceptionReadClassSuccess;
1043 end
1044 else
1045 if StrStartsWith(s, Debugger.FExceptionInfo.FExceptMsgCmd, True) then begin
1046 Instr := TLldbInstructionReadExpression.Create;
1047 Instr.OnSuccess := @ExceptionReadMsgSuccess;
1048 end;
1049
1050 if Instr <> nil then begin
1051 ALine := '';
1052 debugln(DBG_VERBOSE, ['Reading exception info']);
1053 assert(InstructionQueue.RunningInstruction = nil, 'InstructionQueue.RunningInstruction = nil');
1054 QueueInstruction(Instr);
1055 Instr.ReleaseReference;
1056 exit;
1057 end;
1058 {%endregion exception }
1059
1060 // STEP 1: Process 10992 stopped
1061 if (FState = crRunning) and StrMatches(ALine, ['Process ', 'stopped']) then begin
1062 FState := crReadingThreads;
1063 debugln(DBG_VERBOSE, ['Reading thread info']);
1064 FThreadInstr := TLldbInstructionThreadListReader.Create();
1065 FThreadInstr.OnSuccess := @ThreadInstructionSucceeded;
1066 QueueInstruction(FThreadInstr);
1067 exit;
1068 end;
1069
1070 // STEP 2: * thread #1, stop reason = breakpoint 6.1
1071 if StrMatches(ALine, ['* thread #', ', stop reason = ', ''], found) then begin
1072 FState := crStopped;
1073 debugln(DBG_VERBOSE, ['Reading stopped thread']);
1074 SetDebuggerLocation(0, 0, '', '', '', 0);
1075 if StrStartsWith(found[1], 'breakpoint ') then begin
1076 FCurBrkId := GetBreakPointId(found[1])
1077 //end else
1078 //if StrStartsWith(found[1], 'watchpoint ') then begin
1079 end else begin
1080 FUnknownStopReason := '';
1081 if not( ( StrStartsWith(found[1], 'step ') or StrStartsWith(found[1], 'instruction step ') ) and
1082 ( StrContains(found[1], ' in') or StrContains(found[1], ' over') or StrContains(found[1], ' out') )
1083 )
1084 then
1085 FUnknownStopReason := found[1];
1086
1087 FCurBrkId := -1;
1088 end;
1089
1090 ParseNewThreadLocation(ALine, AnId, AnIsCurrent, Name, AnAddr,
1091 Stack, Frame, AFuncName, AnArgs, AFile, AFullFile, SrcLine, AReminder);
1092 AnArgs.Free;
1093
1094 Debugger.FCurrentThreadId := AnId;
1095 Debugger.FCurrentStackFrame := 0;
1096 SetDebuggerLocation(AnAddr, Frame, AFuncName, AFile, AFullFile, SrcLine);
1097
1098 InstructionQueue.SetKnownThreadAndFrame(Debugger.FCurrentThreadId, 0);
1099 Debugger.Threads.CurrentThreads.CurrentThreadId := Debugger.FCurrentThreadId; // set again from thread list
1100
1101 if StrStartsWith(found[1], 'breakpoint ') then begin
1102 if FCurBrkId = Debugger.FExceptionBreak.BreakId then
1103 DoException
1104 else
1105 if FCurBrkId = Debugger.FRunErrorBreak.BreakId then
1106 DoRunError // location = frame with fp // see gdbmi
1107 else
1108 if FCurBrkId = Debugger.FBreakErrorBreak.BreakId then
1109 DoRunError // location = frame(1) // see gdbmi
1110 else
1111 if (FCurBrkId = Debugger.FCatchesBreak.BreakId) or
1112 (FCurBrkId = Debugger.FPopExceptStack.BreakId)
1113 then
1114 DoCatchesHit
1115 else
1116 if FCurBrkId = Debugger.FReRaiseBreak.BreakId then begin
1117 FState := crStoppedRaise;
1118 ContinueRunning;
1119 end
1120 else
1121 if FCurBrkId = FTmpBreakId then
1122 DoStopTemp
1123 else
1124 DoBreakPointHit(FCurBrkId);
1125 end
1126 else
1127 if FUnknownStopReason <> '' then begin
1128 DoUnknownStopReason(FUnknownStopReason);
1129 end
1130 else
1131 SetDebuggerState(dsPause);
1132
1133 if (FState = crRunning) then
1134 exit;
1135
1136 if DebuggerState in [dsPause, dsInternalPause, dsStop] then
1137 Debugger.DoCurrent(Debugger.FCurrentLocation);
1138 FState := crDone;
1139 ALine := '';
1140
1141 exit;
1142 end;
1143
1144 if (FState = crRunning) then
1145 exit;
1146
1147 // STEP 3: frame #0: 0x0042b855 &&//FULL: \tmp\New Folder (2)\unit1.pas &&//SHORT: unit1.pas &&//LINE: 54 &&//MOD: project1.exe &&//FUNC: FORMCREATE(this=0x04c81248, SENDER=0x04c81248) <<&&//FRAME
1148 if ParseNewFrameLocation(ALine, AnId, AnIsCurrent, AnAddr, stack, frame, AFuncName, AnArgs,
1149 AFile, AFullFile, SrcLine, AReminder)
1150 then begin
1151 AnArgs.Free;
1152 if FState = crReadingThreads then begin
1153 FState := crStopped;
1154 // did not execute "thread list" / thread cmd reader has read "stop reason"
1155 for i := 0 to length(FThreadInstr.Res) - 1 do
1156 DoLineDataReceived(FThreadInstr.Res[i]);
1157 end;
1158
1159 DeleteTempBreakPoint;
1160 Finished;
1161 end;
1162
1163 if (LeftStr(ALine, 8) = 'Process ') and (pos('exited with status = ', ALine) > 0) then begin
1164 DeleteTempBreakPoint;
1165 Finished;
1166 exit; // handle in main debugger
1167 end;
1168
1169 end;
1170
1171 procedure TLldbDebuggerCommandRun.DoCancel;
1172 begin
1173 InstructionQueue.CancelAllForCommand(Self); // in case there still are any
1174 DeleteTempBreakPoint;
1175 // Must not call Finished; => would cancel DeleteTempBreakPoint;
1176 if CommandQueue.RunningCommand = Self then
1177 CommandQueue.CommandFinished(Self);
1178 end;
1179
1180 procedure TLldbDebuggerCommandRun.DoExecute;
1181 begin
1182 if FWaitToResume then
1183 ResumeWithNextStepCommand
1184 else
1185 DoInitialExecute;
1186 end;
1187
1188 procedure TLldbDebuggerCommandRun.RunInstructionSucceeded(AnInstruction: TObject
1189 );
1190 begin
1191 FCurrentExceptionInfo.FHasCommandData := [];
1192 end;
1193
1194 procedure TLldbDebuggerCommandRun.ResetStateToRun;
1195 begin
1196 FState := crRunning;
1197 FCurBrkId := 0;
1198 if FThreadInstr <> nil then begin
1199 FThreadInstr.ReleaseReference;
1200 FThreadInstr := nil;
1201 end;
1202 FCurrentExceptionInfo.FHasCommandData := [];
1203 end;
1204
1205 procedure TLldbDebuggerCommandRun.SetNextStepCommand(
1206 AStepAction: TLldbInstructionProcessStepAction);
1207 begin
1208 FNextStepAction := AStepAction;
1209 {$IFDEF LLDB_SKIP_SNAP}
1210 ResumeWithNextStepCommand;
1211 exit;
1212 {$ENDIF}
1213 FWaitToResume := True;
1214
1215 // Run the queue, before continue
1216 CommandQueue.QueueCommand(Self);
1217 CommandQueue.CommandFinished(Self);
1218 //CommandQueue.FRunningCommand := nil;
1219 //CommandQueue.Run;
1220 end;
1221
1222 procedure TLldbDebuggerCommandRun.ResumeWithNextStepCommand;
1223 var
1224 Instr: TLldbInstructionProcessStep;
1225 begin
1226 if FNextStepAction in [saOver, saInto, saOut, saInsOver] then
1227 Debugger.FReRaiseBreak.Enable
1228 else
1229 Debugger.FReRaiseBreak.Disable;
1230
1231 if FMode in [cmRunToCatch, cmRunToTmpBrk] then begin
1232 Debugger.FCatchesBreak.Enable;
1233 Debugger.FPopExceptStack.Enable;
1234 Instr := TLldbInstructionProcessStep.Create(saContinue);
1235 end
1236 else begin
1237 Debugger.FCatchesBreak.Disable;
1238 Debugger.FPopExceptStack.Disable;
1239 Instr := TLldbInstructionProcessStep.Create(FNextStepAction, Debugger.FCurrentThreadId);
1240 end;
1241 Instr.OnFinish := @RunInstructionSucceeded;
1242 QueueInstruction(Instr);
1243 Instr.ReleaseReference;
1244 if DebuggerState <> dsRun then
1245 SetDebuggerState(dsRun);
1246 end;
1247
1248 procedure TLldbDebuggerCommandRun.SetTempBreakPoint(AnAddr: TDBGPtr);
1249 var
1250 Instr: TLldbInstructionBreakSet;
1251 begin
1252 Instr := TLldbInstructionBreakSet.Create(AnAddr);
1253 Instr.OnFinish := @TempBreakPointSet;
1254 QueueInstruction(Instr);
1255 Instr.ReleaseReference;
1256 end;
1257
1258 procedure TLldbDebuggerCommandRun.DeleteTempBreakPoint;
1259 var
1260 Instr: TLldbInstruction;
1261 begin
1262 if FTmpBreakId = 0 then
1263 exit;
1264 Instr := TLldbInstructionBreakDelete.Create(FTmpBreakId);
1265 QueueInstruction(Instr);
1266 Instr.ReleaseReference;
1267 FTmpBreakId := 0;
1268 end;
1269
1270 procedure TLldbDebuggerCommandRun.SetDebuggerLocation(AnAddr, AFrame: TDBGPtr;
1271 AFuncName, AFile, AFullFile: String; SrcLine: integer);
1272 begin
1273 Debugger.FCurrentThreadFramePtr := AFrame;
1274 Debugger.FCurrentLocation.Address := AnAddr;
1275 Debugger.FCurrentLocation.FuncName := AFuncName;
1276 Debugger.FCurrentLocation.SrcFile := AFile;
1277 Debugger.FCurrentLocation.SrcFullName := AFullFile;
1278 Debugger.FCurrentLocation.SrcLine := SrcLine;
1279 end;
1280
1281 constructor TLldbDebuggerCommandRun.Create(AOwner: TLldbDebugger);
1282 begin
1283 AOwner.FExceptionInfo.FAtExcepiton := False;
1284 FState := crRunning;
1285 FMode := cmRun;
1286 FFramePtrAtStart := AOwner.FCurrentThreadFramePtr;
1287 inherited Create(AOwner);
1288 end;
1289
1290 destructor TLldbDebuggerCommandRun.Destroy;
1291 begin
1292 FThreadInstr.ReleaseReference;
1293 inherited Destroy;
1294 end;
1295
1296 { TLldbDebuggerCommandLocals }
1297
1298 procedure TLldbDebuggerCommandLocals.LocalsInstructionFinished(Sender: TObject
1299 );
1300 var
1301 n: String;
1302 i: Integer;
1303 begin
1304 if FLocals <> nil then begin
1305 FLocals.Clear;
1306 for i := 0 to FLocalsInstr.Res.Count - 1 do begin
1307 n := FLocalsInstr.Res.Names[i];
1308 FLocals.Add(n, FLocalsInstr.Res.Values[n]);
1309 end;
1310 FLocals.SetDataValidity(ddsValid);
1311 end;
1312
1313 ReleaseRefAndNil(FLocalsInstr);
1314 Finished;
1315 end;
1316
1317 procedure TLldbDebuggerCommandLocals.DoLocalsFreed(Sender: TObject);
1318 begin
1319 FLocals := nil;
1320 if FLocalsInstr <> nil then begin
1321 FLocalsInstr.OnFinish := nil;
1322 FLocalsInstr.Cancel;
1323 ReleaseRefAndNil(FLocalsInstr);
1324 Finished;
1325 end;
1326 end;
1327
1328 procedure TLldbDebuggerCommandLocals.DoExecute;
1329 begin
1330 if FLocals = nil then begin
1331 Finished;
1332 exit;
1333 end;
1334
1335 if FLocalsInstr <> nil then begin
1336 FLocalsInstr.OnFinish := nil;
1337 ReleaseRefAndNil(FLocalsInstr);
1338 end;
1339 FLocalsInstr := TLldbInstructionLocals.Create(FLocals.ThreadId, FLocals.StackFrame);
1340 FLocalsInstr.OnFinish := @LocalsInstructionFinished;
1341 QueueInstruction(FLocalsInstr);
1342 end;
1343
1344 constructor TLldbDebuggerCommandLocals.Create(AOwner: TLldbDebugger;
1345 ALocals: TLocals);
1346 begin
1347 FLocals := ALocals;
1348 FLocals.AddFreeNotification(@DoLocalsFreed);
1349 CancelableForRun := True;
1350 inherited Create(AOwner);
1351 end;
1352
1353 destructor TLldbDebuggerCommandLocals.Destroy;
1354 begin
1355 if FLocalsInstr <> nil then begin
1356 FLocalsInstr.OnFinish := nil;
1357 ReleaseRefAndNil(FLocalsInstr);
1358 end;
1359 if FLocals <> nil then
1360 FLocals.RemoveFreeNotification(@DoLocalsFreed);
1361 inherited Destroy;
1362 end;
1363
1364 {%endregion ^^^^^ Register ^^^^^ }
1365
1366 {%region
1367 *****
1368 ***** Threads
1369 ***** }
1370
1371 { TLldbDebuggerCommandThreads }
1372
1373 procedure TLldbDebuggerCommandThreads.ThreadInstructionSucceeded(Sender: TObject);
1374 begin
1375 TLldbThreads(Debugger.Threads).ReadFromThreadInstruction(TLldbInstructionThreadList(Sender));
1376 Finished;
1377 end;
1378
1379 constructor TLldbDebuggerCommandThreads.Create(AOwner: TLldbDebugger);
1380 begin
1381 CancelableForRun := True;
1382 inherited Create(AOwner);
1383 end;
1384
1385 procedure TLldbDebuggerCommandThreads.DoExecute;
1386 var
1387 Instr: TLldbInstructionThreadList;
1388 begin
1389 Instr := TLldbInstructionThreadList.Create();
1390 Instr.OnFinish := @ThreadInstructionSucceeded;
1391 QueueInstruction(Instr);
1392 Instr.ReleaseReference;
1393 end;
1394
1395 { TLldbThreads }
1396
TLldbThreads.GetDebuggernull1397 function TLldbThreads.GetDebugger: TLldbDebugger;
1398 begin
1399 Result := TLldbDebugger(inherited Debugger);
1400 end;
1401
1402 procedure TLldbThreads.DoStateEnterPause;
1403 begin
1404 inherited DoStateEnterPause;
1405 Changed;
1406 end;
1407
1408 procedure TLldbThreads.ReadFromThreadInstruction(
1409 Instr: TLldbInstructionThreadList; ACurrentId: Integer);
1410 var
1411 i, j, line: Integer;
1412 s, func, filename, name, d, fullfile: String;
1413 found, foundFunc, foundArg: TStringArray;
1414 TId, CurThrId: LongInt;
1415 CurThr: Boolean;
1416 Arguments: TStringList;
1417 addr, stack, frame: TDBGPtr;
1418 te: TThreadEntry;
1419 begin
1420 CurrentThreads.Clear;
1421 SetLength(FThreadFramePointers, Length(Instr.Res));
1422 for i := 0 to Length(Instr.Res) - 1 do begin
1423 s := Instr.Res[i];
1424 ParseNewThreadLocation(s, TId, CurThr, name, addr, stack, frame, func, Arguments, filename, fullfile, line, d);
1425 FThreadFramePointers[i] := frame;
1426 if CurThr then
1427 CurThrId := TId;
1428
1429 te := CurrentThreads.CreateEntry(
1430 addr,
1431 Arguments,
1432 func,
1433 filename, fullfile,
1434 line,
1435 TId, name, ''
1436 );
1437 CurrentThreads.Add(te);
1438 te.Free;
1439
1440 Arguments.Free;
1441 end;
1442
1443 if ACurrentId >= 0 then
1444 CurThrId := ACurrentId;
1445 CurrentThreads.CurrentThreadId := CurThrId;
1446 CurrentThreads.SetValidity(ddsValid);
1447 end;
1448
1449 procedure TLldbThreads.RequestMasterData;
1450 var
1451 Cmd: TLldbDebuggerCommandThreads;
1452 RunCmd: TLldbDebuggerCommand;
1453 Instr: TLldbInstructionThreadList;
1454 begin
1455 if not (Debugger.State in [dsPause, dsInternalPause]) then
1456 exit;
1457
1458 RunCmd := Debugger.CommandQueue.RunningCommand;
1459 if RunCmd is TLldbDebuggerCommandRun then begin
1460 Instr := TLldbDebuggerCommandRun(RunCmd).FThreadInstr;
1461 if (Instr <> nil) and Instr.IsSuccess then begin
1462 // FThreadInstr, may have the wrong thread marked. Use Debugger.FCurrentThreadId (which should not have changed since the RunCommand set it)
1463 ReadFromThreadInstruction(TLldbInstructionThreadList(Instr), Debugger.FCurrentThreadId);
1464 exit;
1465 end;
1466 end;
1467
1468 Cmd := TLldbDebuggerCommandThreads.Create(Debugger);
1469 Debugger.QueueCommand(Cmd);
1470 Cmd.ReleaseReference;
1471 end;
1472
1473 procedure TLldbThreads.ChangeCurrentThread(ANewId: Integer);
1474 begin
1475 if Debugger = nil then Exit;
1476 if not(Debugger.State in [dsPause, dsInternalPause]) then exit;
1477
1478 Debugger.FCurrentThreadId := ANewId;
1479 Debugger.FCurrentThreadFramePtr := GetFramePointerForThread(ANewId);
1480
1481 if CurrentThreads <> nil
1482 then CurrentThreads.CurrentThreadId := ANewId;
1483
1484 TLldbCallStack(Debugger.CallStack).DoThreadChanged;
1485 end;
1486
GetFramePointerForThreadnull1487 function TLldbThreads.GetFramePointerForThread(AnId: Integer): TDBGPtr;
1488 begin
1489 if (AnId < 0) or (AnId >= Length(FThreadFramePointers)) then
1490 exit(0);
1491 Result := FThreadFramePointers[AnId];
1492 end;
1493
1494 {%endregion ^^^^^ Threads ^^^^^ }
1495
1496 {%region
1497 *****
1498 ***** CallStack
1499 ***** }
1500
1501 { TLldbDebuggerCommandCallStack }
1502
1503 procedure TLldbDebuggerCommandCallStack.StackInstructionFinished(Sender: TObject
1504 );
1505 var
1506 Instr: TLldbInstructionStackTrace absolute Sender;
1507 i, FId, line: Integer;
1508 e: TCallStackEntry;
1509 found, foundArg: TStringArray;
1510 Arguments: TStringList;
1511 It: TMapIterator;
1512 s, func, filename, d, fullfile: String;
1513 IsCur: Boolean;
1514 addr, stack, frame: TDBGPtr;
1515 begin
1516 if FCurrentCallStack = nil then begin
1517 Finished;
1518 exit;
1519 end;
1520
1521 It := TMapIterator.Create(FCurrentCallStack.RawEntries);
1522
1523 for i := 0 to Length(Instr.Res) - 1 do begin
1524 s := Instr.Res[i];
1525 ParseNewFrameLocation(s, FId, IsCur, addr, stack, frame, func, Arguments, filename, fullfile, line, d);
1526 if It.Locate(FId) then begin
1527 e := TCallStackEntry(It.DataPtr^);
1528 e.Init(addr, Arguments, func, filename, fullfile, line);
1529 end;
1530 Arguments.Free;
1531 end;
1532 It.Free;
1533
1534 TLldbCallStack(Debugger.CallStack).ParentRequestEntries(FCurrentCallStack);
1535
1536 Finished;
1537 end;
1538
1539 procedure TLldbDebuggerCommandCallStack.DoCallstackFreed(Sender: TObject);
1540 begin
1541 FCurrentCallStack := nil;
1542 //TODO cancel
1543 end;
1544
1545 procedure TLldbDebuggerCommandCallStack.DoExecute;
1546 var
1547 StartIdx, EndIdx: Integer;
1548 Instr: TLldbInstructionStackTrace;
1549 begin
1550 if FCurrentCallStack = nil then begin
1551 Finished;
1552 exit;
1553 end;
1554
1555 StartIdx := Max(FCurrentCallStack.LowestUnknown, 0);
1556 EndIdx := FCurrentCallStack.HighestUnknown;
1557 if EndIdx < StartIdx then begin
1558 Finished;
1559 exit;
1560 end;
1561
1562 Instr := TLldbInstructionStackTrace.Create(EndIdx+1, FCurrentCallStack.ThreadId);
1563 Instr.OnFinish := @StackInstructionFinished;
1564 QueueInstruction(Instr);
1565 Instr.ReleaseReference;
1566 end;
1567
1568 constructor TLldbDebuggerCommandCallStack.Create(AOwner: TLldbDebugger;
1569 ACurrentCallStack: TCallStackBase);
1570 begin
1571 inherited Create(AOwner);
1572 FCurrentCallStack := ACurrentCallStack;
1573 FCurrentCallStack.AddFreeNotification(@DoCallstackFreed);
1574 CancelableForRun := True;
1575 end;
1576
1577 destructor TLldbDebuggerCommandCallStack.Destroy;
1578 begin
1579 if FCurrentCallStack <> nil then
1580 FCurrentCallStack.RemoveFreeNotification(@DoCallstackFreed);
1581 inherited Destroy;
1582 end;
1583
1584 { TLldbCallStack }
1585
1586 procedure TLldbCallStack.DoThreadChanged;
1587 var
1588 tid, idx: Integer;
1589 cs: TCallStackBase;
1590 begin
1591 if (Debugger = nil) or not(Debugger.State in [dsPause, dsInternalPause]) then begin
1592 exit;
1593 end;
1594
1595 TLldbDebugger(Debugger).FCurrentStackFrame := 0;
1596 tid := Debugger.Threads.CurrentThreads.CurrentThreadId;
1597 cs := TCallStackBase(CurrentCallStackList.EntriesForThreads[tid]);
1598 idx := cs.CurrentIndex; // CURRENT
1599 if idx < 0 then idx := 0;
1600
1601 TLldbDebugger(Debugger).FCurrentStackFrame := idx;
1602 cs.CurrentIndex := idx;
1603 end;
1604
1605 procedure TLldbCallStack.ParentRequestEntries(ACallstack: TCallStackBase);
1606 begin
1607 inherited RequestEntries(ACallstack);
1608 end;
1609
1610 procedure TLldbCallStack.RequestAtLeastCount(ACallstack: TCallStackBase;
1611 ARequiredMinCount: Integer);
1612 begin
1613 if (Debugger = nil) or not(Debugger.State in [dsPause, dsInternalPause]) then begin
1614 ACallstack.SetCurrentValidity(ddsInvalid);
1615 Exit;
1616 end;
1617
1618 ACallstack.Count := ARequiredMinCount + 1; // TODO: get data, and return correct result
1619 ACallstack.SetCountValidity(ddsValid);
1620 end;
1621
1622 procedure TLldbCallStack.UpdateCurrentIndex;
1623 var
1624 tid, idx: Integer;
1625 cs: TCallStackBase;
1626 begin
1627 if (Debugger = nil) or not(Debugger.State in [dsPause, dsInternalPause]) then begin
1628 exit;
1629 end;
1630
1631 tid := Debugger.Threads.CurrentThreads.CurrentThreadId; // FCurrentThreadId ?
1632 cs := TCallStackBase(CurrentCallStackList.EntriesForThreads[tid]);
1633 idx := cs.NewCurrentIndex; // NEW-CURRENT
1634
1635 if TLldbDebugger(Debugger).FCurrentStackFrame = idx then Exit;
1636
1637 TLldbDebugger(Debugger).FCurrentStackFrame := idx;
1638
1639 if cs <> nil then begin
1640 cs.CurrentIndex := idx;
1641 cs.SetCurrentValidity(ddsValid);
1642 end;
1643 end;
1644
1645 procedure TLldbCallStack.RequestCurrent(ACallstack: TCallStackBase);
1646 begin
1647 if (Debugger = nil) or not(Debugger.State in [dsPause, dsInternalPause]) then begin
1648 ACallstack.SetCurrentValidity(ddsInvalid);
1649 Exit;
1650 end;
1651
1652 if ACallstack.ThreadId = TLldbDebugger(Debugger).FCurrentThreadId
1653 then ACallstack.CurrentIndex := TLldbDebugger(Debugger).FCurrentStackFrame
1654 else ACallstack.CurrentIndex := 0; // will be used, if thread is changed
1655 ACallstack.SetCurrentValidity(ddsValid);
1656 end;
1657
1658 procedure TLldbCallStack.RequestEntries(ACallstack: TCallStackBase);
1659 var
1660 Cmd: TLldbDebuggerCommandCallStack;
1661 begin
1662 if not (Debugger.State in [dsPause, dsInternalPause]) then
1663 exit;
1664
1665 Cmd := TLldbDebuggerCommandCallStack.Create(TLldbDebugger(Debugger), ACallstack);
1666 TLldbDebugger(Debugger).QueueCommand(Cmd);
1667 Cmd.ReleaseReference;
1668 end;
1669
1670 {%endregion ^^^^^ CallStack ^^^^^ }
1671
1672 { TLldbLocals }
1673
1674 procedure TLldbLocals.RequestData(ALocals: TLocals);
1675 var
1676 Cmd: TLldbDebuggerCommandLocals;
1677 begin
1678 if (Debugger = nil) or not(Debugger.State in [dsPause, dsInternalPause]) then Exit;
1679
1680 Cmd := TLldbDebuggerCommandLocals.Create(TLldbDebugger(Debugger), ALocals);
1681 TLldbDebugger(Debugger).QueueCommand(Cmd);
1682 Cmd.ReleaseReference;
1683 end;
1684
1685 { TLldbWatches }
1686
1687 procedure TLldbWatches.InternalRequestData(AWatchValue: TWatchValue);
1688 var
1689 Cmd: TLldbDebuggerCommandEvaluate;
1690 begin
1691 if (Debugger = nil) or not(Debugger.State in [dsPause, dsInternalPause]) then Exit;
1692
1693 Cmd := TLldbDebuggerCommandEvaluate.Create(TLldbDebugger(Debugger), AWatchValue);
1694 TLldbDebugger(Debugger).QueueCommand(Cmd);
1695 Cmd.ReleaseReference;
1696 end;
1697
1698 { TLldbBreakPoint }
1699
1700 procedure TLldbBreakPoint.SetBreakPoint;
1701 var
1702 i: Integer;
1703 s: String;
1704 Instr: TLldbInstruction;
1705 en: Boolean;
1706 begin
1707 debugln(DBG_VERBOSE, ['TLldbBreakPoint.SetBreakPoint ']);
1708
1709 if FCurrentInstruction <> nil then begin
1710 if (FBreakID <> 0) or (not FCurrentInstruction.IsRunning) then begin
1711 // Can be a queued SetBreak => replace
1712 // Or an Update => don't care, ReleaseBreakpoint will be called
1713 CancelCurrentInstruction;
1714 end
1715 else begin
1716 // already running a SetBreakPoint
1717 FNeededChanges := FNeededChanges + [ciLocation]; // wait for instruction to finish // need ID to del
1718 exit;
1719 end;
1720 end;
1721
1722 if (FBreakID <> 0) then
1723 ReleaseBreakPoint;
1724
1725 en := Enabled;
1726 if TLldbDebugger(Debugger).FLldbMissingBreakSetDisable and (not en) and (Kind <> bpkData) then begin
1727 en := True;
1728 FNeededChanges := FNeededChanges + [ciEnabled];
1729 end;
1730
1731 case Kind of
1732 bpkSource: begin
1733 i := LastPos(PathDelim, Source);
1734 if i > 0 then
1735 s := Copy(Source, i+1, Length(Source))
1736 else
1737 s := Source;
1738 Instr := TLldbInstructionBreakSet.Create(s, Line, not en, Expression);
1739 end;
1740 bpkAddress: begin
1741 Instr := TLldbInstructionBreakSet.Create(Address, not en, Expression);
1742 end;
1743 bpkData: begin
1744 if not Enabled then // do not set, if not enabled
1745 exit;
1746 // TODO: scope
1747 // TODO: apply , Expression, not Enabled
1748 Instr := TLldbInstructionWatchSet.Create(WatchData, WatchKind);
1749 if Expression <> '' then
1750 FNeededChanges := FNeededChanges + [ciCondition];
1751 end;
1752 end;
1753
1754 Instr.OnFinish := @InstructionSetBreakFinished;
1755 TLldbDebugger(Debugger).FDebugInstructionQueue.QueueInstruction(Instr);
1756 FCurrentInstruction := Instr;
1757 end;
1758
1759 procedure TLldbBreakPoint.InstructionSetBreakFinished(Sender: TObject);
1760 var
1761 nc: TDbgBpChangeIndicators;
1762 begin
1763 DoCurrentInstructionFinished;
1764
1765 if TLldbInstructionBreakOrWatchSet(Sender).LldbNoDisableError then begin
1766 TLldbDebugger(Debugger).FLldbMissingBreakSetDisable := True;
1767 FNeededChanges := FNeededChanges + [ciLocation]
1768 end;
1769
1770 if TLldbInstructionBreakOrWatchSet(Sender).IsSuccess then begin
1771 FBreakID := TLldbInstructionBreakOrWatchSet(Sender).BreakId;
1772 if FNeededChanges * [ciDestroy, ciLocation] = [] then
1773 SetValid(TLldbInstructionBreakOrWatchSet(Sender).State);
1774 end
1775 else
1776 SetValid(vsInvalid);
1777
1778 nc := FNeededChanges;
1779 FNeededChanges := [];
1780 MarkPropertiesChanged(nc);
1781 end;
1782
1783 procedure TLldbBreakPoint.InstructionUpdateBreakFinished(Sender: TObject);
1784 var
1785 nc: TDbgBpChangeIndicators;
1786 begin
1787 DoCurrentInstructionFinished;
1788
1789 nc := FNeededChanges;
1790 FNeededChanges := [];
1791 MarkPropertiesChanged(nc);
1792 end;
1793
1794 procedure TLldbBreakPoint.ReleaseBreakPoint;
1795 var
1796 Instr: TLldbInstruction;
1797 begin
1798 CancelCurrentInstruction;
1799
1800 if FBreakID <= 0 then exit;
1801 SetHitCount(0);
1802
1803 case Kind of
1804 bpkSource, bpkAddress:
1805 Instr := TLldbInstructionBreakDelete.Create(FBreakID);
1806 bpkData:
1807 Instr := TLldbInstructionWatchDelete.Create(FBreakID);
1808 end;
1809 FBreakID := 0; // Allow a new location to be set immediately
1810
1811 //Instr.OwningCommand := Self; // if it needs to be cancelled
1812 TLldbDebugger(Debugger).FDebugInstructionQueue.QueueInstruction(Instr);
1813 Instr.ReleaseReference;
1814 end;
1815
1816 procedure TLldbBreakPoint.UpdateProperties(AChanged: TDbgBpChangeIndicators);
1817 var
1818 Instr: TLldbInstruction;
1819 begin
1820 assert(AChanged * [ciEnabled, ciCondition] <> [], 'break.UpdateProperties() AChanged * [ciEnabled, ciCondition] <> []');
1821
1822 if (FCurrentInstruction <> nil) then begin
1823 FNeededChanges := FNeededChanges + AChanged;
1824 exit;
1825 end;
1826
1827 if FBreakID = 0 then // SetBreakPoint may have failed / nothing to do
1828 exit;
1829
1830 case Kind of
1831 bpkSource, bpkAddress:
1832 if ciCondition in AChanged
1833 then Instr := TLldbInstructionBreakModify.Create(FBreakID, not Enabled, Expression)
1834 else Instr := TLldbInstructionBreakModify.Create(FBreakID, not Enabled);
1835 bpkData:
1836 begin
1837 if Enabled <> (FBreakID <> 0) then begin
1838 if Enabled
1839 then SetBreakPoint // will
1840 else ReleaseBreakPoint;
1841 exit;
1842 end;
1843 if ciCondition in AChanged then
1844 Instr := TLldbInstructionWatchModify.Create(FBreakID, Expression);
1845 end;
1846 end;
1847
1848 TLldbDebugger(Debugger).FDebugInstructionQueue.QueueInstruction(Instr);
1849 Instr.OnFinish := @InstructionUpdateBreakFinished;
1850 FCurrentInstruction := Instr;
1851 end;
1852
1853 procedure TLldbBreakPoint.DoCurrentInstructionFinished;
1854 begin
1855 if FCurrentInstruction <> nil then begin
1856 FCurrentInstruction.OnFinish := nil;
1857 ReleaseRefAndNil(FCurrentInstruction);
1858 end;
1859 end;
1860
1861 procedure TLldbBreakPoint.CancelCurrentInstruction;
1862 begin
1863 if FCurrentInstruction <> nil then begin
1864 FCurrentInstruction.OnFinish := nil;
1865 FCurrentInstruction.Cancel;
1866 ReleaseRefAndNil(FCurrentInstruction);
1867 end;
1868 end;
1869
1870 procedure TLldbBreakPoint.DoStateChange(const AOldState: TDBGState);
1871 begin
1872 inherited DoStateChange(AOldState);
1873 case DebuggerState of
1874 dsRun: if AOldState = dsInit then begin
1875 // Disabled data breakpoints: wait until enabled
1876 // Disabled other breakpoints: Give to LLDB to see if they are valid
1877 SetBreakPoint
1878 end;
1879 dsStop: begin
1880 if FBreakID > 0
1881 then ReleaseBreakpoint;
1882 end;
1883 end;
1884 end;
1885
1886 procedure TLldbBreakPoint.DoPropertiesChanged(AChanged: TDbgBpChangeIndicators);
1887 begin
1888 FNeededChanges := [];
1889 if not (DebuggerState in [dsPause, dsInternalPause, dsRun]) then
1890 exit;
1891
1892 if ciDestroy in AChanged then begin
1893 ReleaseBreakPoint;
1894 DoCurrentInstructionFinished;
1895 exit;
1896 end;
1897
1898 if AChanged * [ciLocation, ciCreated] <> [] then
1899 SetBreakPoint
1900 else
1901 UpdateProperties(AChanged);
1902 end;
1903
1904 destructor TLldbBreakPoint.Destroy;
1905 begin
1906 DoCurrentInstructionFinished;
1907 inherited Destroy;
1908 end;
1909
1910 { TLldbBreakPoints }
1911
FindByIdnull1912 function TLldbBreakPoints.FindById(AnId: Integer): TLldbBreakPoint;
1913 var
1914 i: Integer;
1915 begin
1916 for i := 0 to Count - 1 do begin
1917 Result := TLldbBreakPoint(Items[i]);
1918 if Result.FBreakID = AnId then
1919 exit;
1920 end;
1921 Result := nil;
1922 end;
1923
1924 {%region
1925 *****
1926 ***** Register
1927 ***** }
1928
1929 { TLldbDebuggerCommandRegister }
1930
1931 procedure TLldbDebuggerCommandRegister.RegisterInstructionFinished(
1932 Sender: TObject);
1933 var
1934 Instr: TLldbInstructionRegister absolute Sender;
1935 RegVal: TRegisterValue;
1936 n: String;
1937 i: Integer;
1938 begin
1939 if not Instr.IsSuccess then begin
1940 if FRegisters.DataValidity in [ddsRequested, ddsEvaluating] then
1941 FRegisters.DataValidity := ddsInvalid;
1942 exit;
1943 end;
1944
1945 FRegisters.DataValidity := ddsEvaluating;
1946
1947 for i := 0 to Instr.Res.Count - 1 do begin
1948 n := Instr.Res.Names[i];
1949 RegVal := FRegisters.EntriesByName[n];
1950 RegVal.Value := Instr.Res.Values[n];
1951 RegVal.DataValidity := ddsValid;
1952 end;
1953
1954 FRegisters.DataValidity := ddsValid;
1955 Finished;
1956 end;
1957
1958 procedure TLldbDebuggerCommandRegister.DoExecute;
1959 var
1960 Instr: TLldbInstructionRegister;
1961 begin
1962 // TODO: store thread/frame when command is created
1963 Instr := TLldbInstructionRegister.Create(FRegisters.ThreadId, FRegisters.StackFrame);
1964 Instr.OnFinish := @RegisterInstructionFinished;
1965 QueueInstruction(Instr);
1966 Instr.ReleaseReference;
1967 end;
1968
1969 procedure TLldbDebuggerCommandRegister.DoCancel;
1970 begin
1971 if FRegisters <> nil then
1972 FRegisters.DataValidity := ddsInvalid;
1973 inherited DoCancel;
1974 end;
1975
1976 constructor TLldbDebuggerCommandRegister.Create(AOwner: TLldbDebugger;
1977 ARegisters: TRegisters);
1978 begin
1979 FRegisters := ARegisters;
1980 FRegisters.AddReference;
1981 CancelableForRun := True;
1982 inherited Create(AOwner);
1983 end;
1984
1985 destructor TLldbDebuggerCommandRegister.Destroy;
1986 begin
1987 ReleaseRefAndNil(FRegisters);
1988 inherited Destroy;
1989 end;
1990
1991 { TLldbRegisterSupplier }
1992
1993 procedure TLldbRegisterSupplier.Changed;
1994 begin
1995 if CurrentRegistersList <> nil
1996 then CurrentRegistersList.Clear;
1997 end;
1998
1999 procedure TLldbRegisterSupplier.RequestData(ARegisters: TRegisters);
2000 var
2001 Cmd: TLldbDebuggerCommandRegister;
2002 begin
2003 if (Debugger = nil) or not(Debugger.State in [dsPause, dsInternalPause, dsStop]) then
2004 exit;
2005
2006 Cmd := TLldbDebuggerCommandRegister.Create(TLldbDebugger(Debugger), ARegisters);
2007 TLldbDebugger(Debugger).QueueCommand(Cmd);
2008 Cmd.ReleaseReference;
2009 end;
2010
2011 {%endregion ^^^^^ Register ^^^^^ }
2012
2013 { TLldbDebuggerCommandQueue }
2014
Getnull2015 function TLldbDebuggerCommandQueue.Get(Index: Integer): TLldbDebuggerCommand;
2016 begin
2017 Result := TLldbDebuggerCommand(inherited Get(Index));
2018 end;
2019
2020 procedure TLldbDebuggerCommandQueue.Put(Index: Integer;
2021 const AValue: TLldbDebuggerCommand);
2022 begin
2023 inherited Put(Index, AValue);
2024 end;
2025
2026 procedure TLldbDebuggerCommandQueue.QueueCommand(AValue: TLldbDebuggerCommand);
2027 begin
2028 debugln(DBG_VERBOSE, ['CommandQueue.QueueCommand ', AValue.ClassName]);
2029 Insert(Count, AValue);
2030 Run;
2031 end;
2032
2033 procedure TLldbDebuggerCommandQueue.DoLineDataReceived(var ALine: String);
2034 begin
2035 if FRunningCommand <> nil then
2036 FRunningCommand.DoLineDataReceived(ALine);
2037 end;
2038
2039 procedure TLldbDebuggerCommandQueue.Run;
2040 begin
2041 if (FRunningCommand <> nil) or (FLockQueueRun > 0) then
2042 exit;
2043 {$IFnDEF LLDB_SKIP_IDLE}
2044 if Count = 0 then begin
2045 if Assigned(FDebugger.OnIdle) and (not FDebugger.FInIdle) then begin
2046 FDebugger.FInIdle := True;
2047 LockQueueRun;
2048 FDebugger.OnIdle(Self);
2049 UnLockQueueRun;
2050 FDebugger.FInIdle := False;
2051 end;
2052 exit;
2053 end;
2054 {$ENDIF}
2055
2056 FRunningCommand := Items[0];
2057 FRunningCommand.AddReference;
2058 Delete(0);
2059 DebugLnEnter(DBG_VERBOSE, ['||||||||>>> CommandQueue.Run ', FRunningCommand.ClassName, ', ', dbgs(fDebugger.State), ' Cnt:',Count]);
2060 FRunningCommand.Execute;
2061 // debugger and queue may get destroyed at the end of execute
2062 end;
2063
2064 procedure TLldbDebuggerCommandQueue.CommandFinished(
2065 ACommand: TLldbDebuggerCommand);
2066 begin
2067 if FRunningCommand = ACommand then begin
2068 DebugLnExit(DBG_VERBOSE, ['||||||||<<< CommandQueue.Run ', FRunningCommand.ClassName, ', ', dbgs(fDebugger.State), ' Cnt:',Count]);
2069 ReleaseRefAndNil(FRunningCommand);
2070 end//;
2071 else DebugLn(DBG_VERBOSE, ['|||||||| TLldbDebuggerCommandQueue.CommandFinished >> unknown ???', ', ', dbgs(fDebugger.State), ' Cnt:',Count]);
2072 if not(FDebugger.State in [dsError, dsDestroying, dsNone]) then
2073 Run;
2074 end;
2075
2076 constructor TLldbDebuggerCommandQueue.Create(ADebugger: TLldbDebugger);
2077 begin
2078 FDebugger := ADebugger;
2079 inherited Create;
2080 end;
2081
2082 destructor TLldbDebuggerCommandQueue.Destroy;
2083 begin
2084 while Count > 0 do
2085 Delete(0);
2086 if FRunningCommand <> nil then begin
2087 DebugLnExit(DBG_VERBOSE, ['<<< CommandQueue.Run (Destroy)', FRunningCommand.ClassName, ', ', fDebugger.State]);
2088 ReleaseRefAndNil(FRunningCommand);
2089 end;
2090 inherited Destroy;
2091 end;
2092
2093 procedure TLldbDebuggerCommandQueue.CancelAll;
2094 var
2095 i: Integer;
2096 begin
2097 i := Count - 1;
2098 while i >= 0 do begin
2099 Items[i].Cancel;
2100 dec(i);
2101 if i > Count then
2102 i := Count - 1;
2103 end;
2104 if FRunningCommand <> nil then
2105 FRunningCommand.Cancel;
2106 end;
2107
2108 procedure TLldbDebuggerCommandQueue.CancelForRun;
2109 var
2110 i: Integer;
2111 begin
2112 i := Count - 1;
2113 while i >= 0 do begin
2114 if Items[i].CancelableForRun then
2115 Items[i].Cancel;
2116 dec(i);
2117 if i > Count then
2118 i := Count - 1;
2119 end;
2120 if (FRunningCommand <> nil) and (FRunningCommand.CancelableForRun) then
2121 FRunningCommand.Cancel;
2122 end;
2123
2124 procedure TLldbDebuggerCommandQueue.LockQueueRun;
2125 begin
2126 inc(FLockQueueRun);
2127 debugln(DBG_VERBOSE, ['TLldbDebuggerCommandQueue.LockQueueRun ',FLockQueueRun]);
2128 end;
2129
2130 procedure TLldbDebuggerCommandQueue.UnLockQueueRun;
2131 begin
2132 debugln(DBG_VERBOSE, ['TLldbDebuggerCommandQueue.UnLockQueueRun ',FLockQueueRun]);
2133 dec(FLockQueueRun);
2134 if FLockQueueRun = 0 then Run;
2135 end;
2136
2137 { TLldbDebuggerCommand }
2138
GetDebuggerStatenull2139 function TLldbDebuggerCommand.GetDebuggerState: TDBGState;
2140 begin
2141 Result := Debugger.State;
2142 end;
2143
2144 procedure TLldbDebuggerCommand.InstructionSucceeded(AnInstruction: TObject);
2145 begin
2146 Finished;
2147 end;
2148
2149 procedure TLldbDebuggerCommand.InstructionFailed(AnInstruction: TObject);
2150 begin
2151 SetDebuggerState(dsError);
2152 Finished;
2153 end;
2154
2155 procedure TLldbDebuggerCommand.Finished;
2156 begin
2157 InstructionQueue.CancelAllForCommand(Self); // in case there still are any
2158 CommandQueue.CommandFinished(Self);
2159 end;
2160
GetCommandQueuenull2161 function TLldbDebuggerCommand.GetCommandQueue: TLldbDebuggerCommandQueue;
2162 begin
2163 Result := Debugger.FCommandQueue;
2164 end;
2165
GetInstructionQueuenull2166 function TLldbDebuggerCommand.GetInstructionQueue: TLldbInstructionQueue;
2167 begin
2168 Result := Debugger.FDebugInstructionQueue;
2169 end;
2170
2171 procedure TLldbDebuggerCommand.QueueInstruction(AnInstruction: TLldbInstruction);
2172 begin
2173 AnInstruction.OwningCommand := Self;
2174 InstructionQueue.QueueInstruction(AnInstruction);
2175 end;
2176
2177 procedure TLldbDebuggerCommand.SetDebuggerState(const AValue: TDBGState);
2178 begin
2179 Debugger.SetState(AValue);
2180 end;
2181
2182 constructor TLldbDebuggerCommand.Create(AOwner: TLldbDebugger);
2183 begin
2184 FOwner := AOwner;
2185 inherited Create;
2186 AddReference;
2187 end;
2188
2189 destructor TLldbDebuggerCommand.Destroy;
2190 begin
2191 if InstructionQueue <> nil then
2192 InstructionQueue.CancelAllForCommand(Self);
2193 inherited Destroy;
2194 end;
2195
2196 procedure TLldbDebuggerCommand.Execute;
2197 var
2198 d: TLldbDebugger;
2199 begin
2200 FIsRunning := True;
2201 d := Debugger;
2202 try
2203 AddReference;
2204 d.LockRelease;
2205 DoExecute; // may call Finished and Destroy Self
2206 finally
2207 d.UnlockRelease;
2208 ReleaseReference;
2209 end;
2210 end;
2211
2212 procedure TLldbDebuggerCommand.Cancel;
2213 begin
2214 AddReference;
2215 Debugger.CommandQueue.Remove(Self); // current running command is not on queue // dec refcount, may call destroy
2216 if FIsRunning then
2217 DoCancel; // should call CommandQueue.CommandFinished
2218 ReleaseReference;
2219 end;
2220
2221 procedure TLldbDebuggerCommand.DoLineDataReceived(var ALine: String);
2222 begin
2223 //
2224 end;
2225
2226 procedure TLldbDebuggerCommand.DoCancel;
2227 begin
2228 //
2229 end;
2230
2231 { TLldbDebuggerCommandInit }
2232
2233 procedure TLldbDebuggerCommandInit.DoExecute;
2234 const
2235 FRAME_INFO =
2236 '${frame.pc}, {${frame.sp}}, {${frame.fp}}' +
2237 ' &&//FULL: {${line.file.fullpath}} &&//SHORT: {${line.file.basename}} &&//LINE: {${line.number}}' +
2238 ' &&//MOD: {${module.file.basename}} &&//FUNC: {${function.name-with-args}}' +
2239 ' <<&&//FRAME';
2240 var
2241 Instr: TLldbInstruction;
2242 begin
2243 Instr := TLldbInstructionSettingSet.Create('frame-format',
2244 '"frame #${frame.index}: ' + FRAME_INFO + '\n"'
2245 );
2246 QueueInstruction(Instr);
2247 Instr.ReleaseReference;
2248
2249 Instr := TLldbInstructionSettingSet.Create('thread-format',
2250 '"thread #${thread.index}: tid=${thread.id%tid}: ' + FRAME_INFO +
2251 //'{, activity = ''${thread.info.activity.name}''}{, ${thread.info.trace_messages} messages}' +
2252 '{, stop reason = ${thread.stop-reason}}' +
2253 //'{\nReturn value: ${thread.return-value}}{\nCompleted expression: ${thread.completed-expression}}' +
2254 '\n"'
2255 );
2256 QueueInstruction(Instr);
2257 Instr.ReleaseReference;
2258
2259 // Not all versions of lldb have this
2260 Instr := TLldbInstructionSettingSet.Create('thread-stop-format',
2261 '"thread #${thread.index}: tid=${thread.id%tid}: ' + FRAME_INFO +
2262 //'{, activity = ''${thread.info.activity.name}''}{, ${thread.info.trace_messages} messages}' +
2263 '{, stop reason = ${thread.stop-reason}}' +
2264 //'{\nReturn value: ${thread.return-value}}{\nCompleted expression: ${thread.completed-expression}}' +
2265 '\n"'
2266 );
2267 QueueInstruction(Instr);
2268 Instr.ReleaseReference;
2269
2270 Instr := TLldbInstructionTargetStopHook.Create('thread list');
2271 QueueInstruction(Instr);
2272 Instr.ReleaseReference;
2273
2274 Instr := TLldbInstructionSettingSet.Create('stop-line-count-after', '0');
2275 QueueInstruction(Instr);
2276 Instr.ReleaseReference;
2277
2278 Instr := TLldbInstructionSettingSet.Create('stop-line-count-before', '0');
2279 QueueInstruction(Instr);
2280 Instr.ReleaseReference;
2281
2282 Instr := TLldbInstructionSettingSet.Create('stop-disassembly-count', '0');
2283 Instr.OnFinish := @InstructionSucceeded;
2284 QueueInstruction(Instr);
2285 Instr.ReleaseReference;
2286 end;
2287
2288 procedure TLldbDebuggerCommandInit.DoLineDataReceived(var ALine: String);
2289 begin
2290 inherited DoLineDataReceived(ALine);
2291 if FGotLLDB then
2292 exit;
2293 if TLldbDebuggerProperties(Debugger.GetProperties).SkipGDBDetection then
2294 FGotLLDB := True
2295 else
2296 if StrContains(UpperCase(ALine), 'LLDB') then
2297 FGotLLDB := True
2298 else
2299 if StrContains(UpperCase(ALine), '(GDB)') then
2300 Debugger.SetErrorState('GDB detected', 'The external debugger identified itself as GDB. The IDE expected LLDB.');
2301 end;
2302
2303 { TLldbDebuggerCommandRunStep }
2304
2305 procedure TLldbDebuggerCommandRunStep.DoInitialExecute;
2306 begin
2307 SetNextStepCommand(FStepAction);
2308 end;
2309
2310 constructor TLldbDebuggerCommandRunStep.Create(AOwner: TLldbDebugger;
2311 AStepAction: TLldbInstructionProcessStepAction);
2312 var
2313 AtExcepiton: Boolean;
2314 begin
2315 AtExcepiton := AOwner.FExceptionInfo.FAtExcepiton;
2316 FStepAction := AStepAction;
2317 inherited Create(AOwner);
2318 if AtExcepiton and
2319 (AStepAction in [saOver, saInto, saOut])
2320 then
2321 FMode := cmRunToCatch;
2322 end;
2323
2324 { TLldbDebuggerCommandRunLaunch }
2325
2326 procedure TLldbDebuggerCommandRunLaunch.TargetCreated(Sender: TObject);
2327 var
2328 TargetInstr: TLldbInstructionTargetCreate absolute Sender;
2329 Instr: TLldbInstruction;
2330 found: TStringArray;
2331 begin
2332 if not TargetInstr.IsSuccess then begin
2333 SetDebuggerState(dsError);
2334 Finished;
2335 end;
2336 CollectDwarfLoadErrors(Sender);
2337
2338 If StrMatches(TargetInstr.Res, [''{}, '','('{}, ')',''], found) then begin
2339 if (found[1] = 'i386') or (found[1] = 'i686') then begin
2340 DebugLn(DBG_VERBOSE, ['Target 32 bit: ', found[1]]);
2341 Debugger.FTargetWidth := 32;
2342 Debugger.FTargetRegisters[0] := '$eax';
2343 Debugger.FTargetRegisters[1] := '$edx';
2344 Debugger.FTargetRegisters[2] := '$ecx';
2345 end
2346 else
2347 if (found[1] = '(x86_64)') or (found[1] = 'x86_64') then begin
2348 DebugLn(DBG_VERBOSE, ['Target 64 bit: ', found[1]]);
2349 Debugger.FTargetWidth := 64;
2350 // target list gives more detailed result. But until remote debugging is added, use the current system
2351 {$IFDEF MSWindows}
2352 Debugger.FTargetRegisters[0] := '$rcx';
2353 Debugger.FTargetRegisters[1] := '$rdx';
2354 Debugger.FTargetRegisters[2] := '$r8';
2355 {$ELSE}
2356 Debugger.FTargetRegisters[0] := '$rdi';
2357 Debugger.FTargetRegisters[1] := '$rsi';
2358 Debugger.FTargetRegisters[2] := '$rdx';
2359 {$ENDIF}
2360 end
2361 else found := nil;
2362 end
2363 else found := nil;
2364 if found = nil then begin
2365 DebugLn(DBG_VERBOSE, ['Target bitness UNKNOWN']);
2366 // use architecture of IDE
2367 {$IFDEF cpu64}
2368 Debugger.FTargetWidth := 64;
2369 {$IFDEF MSWindows}
2370 Debugger.FTargetRegisters[0] := '$rcx';
2371 Debugger.FTargetRegisters[1] := '$rdx';
2372 Debugger.FTargetRegisters[2] := '$r8';
2373 {$ELSE}
2374 Debugger.FTargetRegisters[0] := '$rdi';
2375 Debugger.FTargetRegisters[1] := '$rsi';
2376 Debugger.FTargetRegisters[2] := '$rdx';
2377 {$ENDIF}
2378 {$ELSE}
2379 Debugger.FTargetWidth := 32;
2380 Debugger.FTargetRegisters[0] := '$eax';
2381 Debugger.FTargetRegisters[1] := '$edx';
2382 Debugger.FTargetRegisters[2] := '$ecx';
2383 {$ENDIF}
2384 end;
2385
2386 if Trim(Debugger.Arguments) <> '' then
2387 Instr := TLldbInstructionSettingSet.Create('target.run-args', Debugger.Arguments)
2388 else
2389 Instr := TLldbInstructionSettingClear.Create('target.run-args');
2390 Instr.OnFinish := @CollectDwarfLoadErrors;
2391 QueueInstruction(Instr);
2392 Instr.ReleaseReference;
2393
2394 Debugger.FBreakErrorBreak.OnFinish := @CollectDwarfLoadErrors;
2395 Debugger.FRunErrorBreak.OnFinish := @CollectDwarfLoadErrors;
2396 Debugger.FExceptionBreak.OnFinish := @ExceptBreakInstructionFinished;
2397 Debugger.FBreakErrorBreak.Enable;
2398 Debugger.FRunErrorBreak.Enable;
2399 Debugger.FExceptionBreak.Enable;
2400 end;
2401
2402 procedure TLldbDebuggerCommandRunLaunch.CollectDwarfLoadErrors(Sender: TObject);
2403 begin
2404 if Sender is TlldbInternalBreakPoint then begin
2405 FLaunchWarnings := FLaunchWarnings + TlldbInternalBreakPoint(Sender).DwarfLoadErrors;
2406 TlldbInternalBreakPoint(Sender).OnFinish := nil;
2407 end
2408 else
2409 FLaunchWarnings := FLaunchWarnings + TLldbInstruction(Sender).DwarfLoadErrors;
2410 end;
2411
2412 procedure TLldbDebuggerCommandRunLaunch.ExceptBreakInstructionFinished(Sender: TObject
2413 );
2414 var
2415 Instr: TLldbInstruction;
2416 BrkId: Integer;
2417 begin
2418 CollectDwarfLoadErrors(Sender);
2419 Debugger.FBreakErrorBreak.OnFinish := nil;
2420
2421 Debugger.FExceptionInfo.FReg0Cmd := '';
2422 Debugger.FExceptionInfo.FReg2Cmd := '';
2423 Debugger.FExceptionInfo.FExceptClassCmd := '';
2424 Debugger.FExceptionInfo.FExceptMsgCmd := '';
2425
2426 BrkId := Debugger.FExceptionBreak.BreakId;
2427 if BrkId > 0 then begin
2428 Debugger.FExceptionInfo.FReg0Cmd := 'p/x ' + Debugger.FTargetRegisters[0];
2429 Debugger.FExceptionInfo.FReg2Cmd := 'p/x ' + Debugger.FTargetRegisters[2];
2430 Debugger.FExceptionInfo.FExceptClassCmd := 'p ((char ***)' + Debugger.FTargetRegisters[0] + ')[0][3]';
2431 Debugger.FExceptionInfo.FExceptMsgCmd := 'p ((char **)' + Debugger.FTargetRegisters[0] + ')[1]';
2432 // 'p ((EXCEPTION *)' + Debugger.FTargetRegisters[0] + ')->FMESSAGE'
2433
2434 Instr := TLldbInstructionBreakAddCommands.Create(BrkId, [
2435 Debugger.FExceptionInfo.FReg0Cmd, Debugger.FExceptionInfo.FReg2Cmd, Debugger.FExceptionInfo.FExceptClassCmd, Debugger.FExceptionInfo.FExceptMsgCmd
2436 ]);
2437 Instr.OnFinish := @CollectDwarfLoadErrors;
2438 QueueInstruction(Instr);
2439 Instr.ReleaseReference;
2440 end;
2441
2442 BrkId := Debugger.FRunErrorBreak.BreakId;
2443 if BrkId > 0 then begin
2444 Debugger.FExceptionInfo.FReg0Cmd := 'p/x ' + Debugger.FTargetRegisters[0];
2445 Instr := TLldbInstructionBreakAddCommands.Create(BrkId, [Debugger.FExceptionInfo.FReg0Cmd]);
2446 Instr.OnFinish := @CollectDwarfLoadErrors;
2447 QueueInstruction(Instr);
2448 Instr.ReleaseReference;
2449 end;
2450
2451 BrkId := Debugger.FBreakErrorBreak.BreakId;
2452 if BrkId > 0 then begin
2453 Debugger.FExceptionInfo.FReg0Cmd := 'p/x ' + Debugger.FTargetRegisters[0];
2454 Instr := TLldbInstructionBreakAddCommands.Create(BrkId, [Debugger.FExceptionInfo.FReg0Cmd]);
2455 Instr.OnFinish := @CollectDwarfLoadErrors;
2456 QueueInstruction(Instr);
2457 Instr.ReleaseReference;
2458 end;
2459
2460 SetDebuggerState(dsRun);
2461 // the state change allows breakpoints to be set, before the run command is issued.
2462
2463 FRunInstr := TLldbInstructionProcessLaunch.Create(TLldbDebuggerProperties(Debugger.GetProperties).LaunchNewTerminal);
2464 FRunInstr.OnSuccess := @LaunchInstructionSucceeded;
2465 FRunInstr.OnFailure := @InstructionFailed;
2466 QueueInstruction(FRunInstr);
2467 FRunInstr.ReleaseReference;
2468 end;
2469
2470 procedure TLldbDebuggerCommandRunLaunch.LaunchInstructionSucceeded(Sender: TObject);
2471 begin
2472 CollectDwarfLoadErrors(Sender);
2473 Debugger.DoAfterLaunch(FLaunchWarnings);
2474 if (not TLldbDebuggerProperties(Debugger.GetProperties).IgnoreLaunchWarnings) and
2475 (FLaunchWarnings <> '') and
2476 assigned(Debugger.OnFeedback)
2477 then begin
2478 case Debugger.OnFeedback(self,
2479 Format('The debugger encountered some errors/warnings while launching the target application.%0:s'
2480 + 'Press "Ok" to continue debugging.%0:s'
2481 + 'Press "Stop" to end the debug session.',
2482 [LineEnding]),
2483 FLaunchWarnings, ftWarning, [frOk, frStop]
2484 ) of
2485 frOk: begin
2486 end;
2487 frStop: begin
2488 Debugger.Stop;
2489 end;
2490 end;
2491 end;
2492 RunInstructionSucceeded(Sender);
2493 end;
2494
2495 procedure TLldbDebuggerCommandRunLaunch.DoInitialExecute;
2496 var
2497 Instr: TLldbInstruction;
2498 begin
2499 Instr := TLldbInstructionTargetCreate.Create(Debugger.FileName);
2500 Instr.OnSuccess := @TargetCreated;
2501 Instr.OnFailure := @InstructionFailed;
2502 QueueInstruction(Instr);
2503 Instr.ReleaseReference;
2504 end;
2505
2506 constructor TLldbDebuggerCommandRunLaunch.Create(AOwner: TLldbDebugger);
2507 begin
2508 FStepAction := saContinue;
2509 inherited Create(AOwner);
2510 end;
2511
2512 { TLldbDebuggerCommandStop }
2513
2514 procedure TLldbDebuggerCommandStop.StopInstructionSucceeded(Sender: TObject);
2515 begin
2516 if DebuggerState <> dsIdle then
2517 SetDebuggerState(dsStop);
2518 end;
2519
2520 procedure TLldbDebuggerCommandStop.DoExecute;
2521 var
2522 Instr: TLldbInstruction;
2523 begin
2524 Instr := TLldbInstructionProcessKill.Create();
2525 Instr.OnSuccess := @StopInstructionSucceeded;
2526 Instr.OnFailure := @InstructionFailed;
2527 QueueInstruction(Instr);
2528 Instr.ReleaseReference;
2529
2530 Instr := TLldbInstructionTargetDelete.Create();
2531 Instr.OnFailure := @InstructionFailed;
2532 QueueInstruction(Instr);
2533 Instr.ReleaseReference;
2534
2535 Instr := TLldbInstructionTargetDelete.Create();
2536 Instr.OnSuccess := @InstructionSucceeded;
2537 Instr.OnFailure := @InstructionFailed;
2538 QueueInstruction(Instr);
2539 Instr.ReleaseReference;
2540 end;
2541
2542 { TLldbDebuggerCommandEvaluate }
2543
2544 procedure TLldbDebuggerCommandEvaluate.EvalInstructionSucceeded(Sender: TObject
2545 );
2546 begin
2547 if FWatchValue <> nil then begin
2548 FWatchValue.Value := FInstr.Res;
2549 //FWatchValue.TypeInfo := TypeInfo;
2550 FWatchValue.Validity := ddsValid;
2551 end
2552 else
2553 if FCallback <> nil then
2554 FCallback(Debugger, True, FInstr.Res, nil);
2555
2556 FInstr.ReleaseReference;
2557 Finished;
2558 end;
2559
2560 procedure TLldbDebuggerCommandEvaluate.EvalInstructionFailed(Sender: TObject);
2561 begin
2562 if FWatchValue <> nil then
2563 FWatchValue.Validity := ddsError
2564 else
2565 if FCallback <> nil then
2566 FCallback(Debugger, False, '', nil);
2567 FInstr.ReleaseReference;
2568 Finished;
2569 end;
2570
2571 procedure TLldbDebuggerCommandEvaluate.DoWatchFreed(Sender: TObject);
2572 begin
2573 FWatchValue := nil;
2574 end;
2575
2576 procedure TLldbDebuggerCommandEvaluate.DoExecute;
2577 begin
2578 if FWatchValue <> nil then
2579 FInstr := TLldbInstructionExpression.Create(FWatchValue.Expression, FWatchValue.ThreadId, FWatchValue.StackFrame)
2580 else
2581 // todo: only if FCallback ?
2582 FInstr := TLldbInstructionExpression.Create(FExpr, Debugger.FCurrentThreadId, Debugger.FCurrentStackFrame);
2583 FInstr.OnSuccess := @EvalInstructionSucceeded;
2584 FInstr.OnFailure := @EvalInstructionFailed;
2585 QueueInstruction(FInstr);
2586 end;
2587
2588 constructor TLldbDebuggerCommandEvaluate.Create(AOwner: TLldbDebugger;
2589 AWatchValue: TWatchValue);
2590 begin
2591 FWatchValue := AWatchValue;
2592 FWatchValue.AddFreeNotification(@DoWatchFreed);
2593 CancelableForRun := True;
2594 inherited Create(AOwner);
2595 end;
2596
2597 constructor TLldbDebuggerCommandEvaluate.Create(AOwner: TLldbDebugger;
2598 AnExpr: String; AFlags: TDBGEvaluateFlags;
2599 ACallback: TDBGEvaluateResultCallback);
2600 begin
2601 FExpr := AnExpr;
2602 FFlags := AFlags;
2603 FCallback := ACallback;
2604 CancelableForRun := True;
2605 inherited Create(AOwner);
2606 end;
2607
2608 destructor TLldbDebuggerCommandEvaluate.Destroy;
2609 begin
2610 if FWatchValue <> nil then
2611 FWatchValue.RemoveFreeNotification(@DoWatchFreed);
2612 inherited Destroy;
2613 end;
2614
2615 { TlldbInternalBreakPoint }
2616
2617 procedure TlldbInternalBreakPoint.QueueInstruction(AnInstr: TLldbInstruction);
2618 begin
2619 AnInstr.OnFinish := @DoFinished;
2620 FDebugger.DebugInstructionQueue.QueueInstruction(AnInstr);
2621 AnInstr.ReleaseReference;
2622 end;
2623
2624 procedure TlldbInternalBreakPoint.BreakSetSuccess(Sender: TObject);
2625 begin
2626 FId := TLldbInstructionBreakSet(Sender).BreakId;
2627 end;
2628
2629 procedure TlldbInternalBreakPoint.DoFailed(Sender: TObject);
2630 begin
2631 if FId = 0 then
2632 FId := -1;
2633 if OnFail <> nil then
2634 OnFail(Self);
2635 end;
2636
2637 procedure TlldbInternalBreakPoint.DoFinished(Sender: TObject);
2638 begin
2639 FDwarfLoadErrors := TLldbInstruction(Sender).DwarfLoadErrors;
2640 if OnFinish <> nil then
2641 OnFinish(Self);
2642 end;
2643
2644 constructor TlldbInternalBreakPoint.Create(AName: String;
2645 ADebugger: TLldbDebugger; ABeforePrologue: Boolean);
2646 begin
2647 FName := AName;
2648 FDebugger := ADebugger;
2649 FBeforePrologue := ABeforePrologue;
2650 FId := 0;
2651 inherited Create;
2652 end;
2653
2654 destructor TlldbInternalBreakPoint.Destroy;
2655 begin
2656 Remove;
2657 inherited Destroy;
2658 end;
2659
2660 procedure TlldbInternalBreakPoint.Enable;
2661 var
2662 Instr: TLldbInstruction;
2663 begin
2664 if FId = 0 then begin
2665 Instr := TLldbInstructionBreakSet.Create(FName, False, FBeforePrologue);
2666 Instr.OnSuccess := @BreakSetSuccess;
2667 Instr.OnFailure := @DoFailed;
2668 QueueInstruction(Instr);
2669 exit;
2670 end;
2671
2672 if FId < 0 then begin
2673 DoFailed(nil);
2674 exit;
2675 end;
2676
2677 Instr := TLldbInstructionBreakModify.Create(FId, False);
2678 Instr.OnFailure := @DoFailed;
2679 QueueInstruction(Instr);
2680 end;
2681
2682 procedure TlldbInternalBreakPoint.Disable;
2683 var
2684 Instr: TLldbInstruction;
2685 begin
2686 if FId <= 0 then
2687 exit;
2688
2689 Instr := TLldbInstructionBreakModify.Create(FId, True);
2690 Instr.OnFailure := @DoFailed;
2691 QueueInstruction(Instr);
2692 end;
2693
2694 procedure TlldbInternalBreakPoint.Remove;
2695 var
2696 Instr: TLldbInstruction;
2697 begin
2698 if FId <= 0 then
2699 exit;
2700
2701 Instr := TLldbInstructionBreakDelete.Create(FId);
2702 QueueInstruction(Instr);
2703 FId := 0;
2704 end;
2705
2706 { TLldbDebugger }
2707
LldbRunnull2708 function TLldbDebugger.LldbRun: Boolean;
2709 var
2710 Cmd: TLldbDebuggerCommandRunLaunch;
2711 begin
2712 DebugLn(DBG_VERBOSE, '*** Run');
2713 Result := True;
2714
2715 if State in [dsPause, dsInternalPause, dsRun] then begin // dsRun in case of exception
2716 CommandQueue.CancelForRun;
2717 LldbStep(saContinue);
2718 exit;
2719 end;
2720
2721 if State in [dsNone, dsIdle, dsStop] then
2722 SetState(dsInit);
2723
2724 FInIdle := False;
2725
2726 DoBeforeLaunch;
2727
2728 Cmd := TLldbDebuggerCommandRunLaunch.Create(Self);
2729 QueueCommand(Cmd);
2730 Cmd.ReleaseReference;
2731 end;
2732
2733 procedure TLldbDebugger.DoAfterLineReceived(var ALine: String);
2734 var
2735 Instr: TLldbInstruction;
2736 begin
2737 if ALine = '' then
2738 exit;
2739
2740 FCommandQueue.DoLineDataReceived(ALine);
2741 if ALine = '' then
2742 exit;
2743
2744
2745 // Process 8888 exited with status = 0 (0x00000000)
2746 if (LeftStr(ALine, 8) = 'Process ') and (pos('exited with status = ', ALine) > 0) then begin
2747 // todo: target delete
2748 if State <> dsIdle then
2749 SetState(dsStop);
2750 ALine := '';
2751
2752 Instr := TLldbInstructionTargetDelete.Create();
2753 FDebugInstructionQueue.QueueInstruction(Instr);
2754 Instr.ReleaseReference;
2755 exit;
2756 end;
2757
2758 end;
2759
2760 procedure TLldbDebugger.DoBeforeLineReceived(var ALine: String);
2761 begin
2762 DoDbgOutput(ALine);
2763 end;
2764
2765 procedure TLldbDebugger.DoBeginReceivingLines(Sender: TObject);
2766 begin
2767 LockRelease;
2768 end;
2769
2770 procedure TLldbDebugger.DoCmdLineDebuggerTerminated(Sender: TObject);
2771 begin
2772 SetState(dsError);
2773 end;
2774
2775 procedure TLldbDebugger.DoLineSentToDbg(Sender: TObject; ALine: String);
2776 begin
2777 DoDbgOutput('>> '+ALine);
2778 end;
2779
2780 procedure TLldbDebugger.DoEndReceivingLines(Sender: TObject);
2781 begin
2782 UnlockRelease;
2783 end;
2784
LldbStepnull2785 function TLldbDebugger.LldbStep(AStepAction: TLldbInstructionProcessStepAction
2786 ): Boolean;
2787 var
2788 Cmd: TLldbDebuggerCommandRunStep;
2789 begin
2790 Result := True;
2791 CommandQueue.CancelForRun;
2792 Cmd := TLldbDebuggerCommandRunStep.Create(Self, AStepAction);
2793 QueueCommand(Cmd);
2794 Cmd.ReleaseReference;
2795 end;
2796
LldbStopnull2797 function TLldbDebugger.LldbStop: Boolean;
2798 var
2799 Cmd: TLldbDebuggerCommandStop;
2800 begin
2801 DebugLn(DBG_VERBOSE, '*** Stop');
2802 Result := True;
2803
2804 CommandQueue.CancelAll;
2805 Cmd := TLldbDebuggerCommandStop.Create(Self);
2806 QueueCommand(Cmd);
2807 Cmd.ReleaseReference;
2808 end;
2809
LldbPausenull2810 function TLldbDebugger.LldbPause: Boolean;
2811 var
2812 Instr: TLldbInstruction;
2813 begin
2814 Result := True;
2815 Instr := TLldbInstructionProcessInterrupt.Create();
2816 FDebugInstructionQueue.QueueInstruction(Instr);
2817 Instr.ReleaseReference;
2818 end;
2819
LldbEvaluatenull2820 function TLldbDebugger.LldbEvaluate(const AExpression: String;
2821 EvalFlags: TDBGEvaluateFlags; ACallback: TDBGEvaluateResultCallback): Boolean;
2822 var
2823 Cmd: TLldbDebuggerCommandEvaluate;
2824 begin
2825 Cmd := TLldbDebuggerCommandEvaluate.Create(Self, AExpression, EvalFlags, ACallback);
2826 QueueCommand(Cmd);
2827 Cmd.ReleaseReference;
2828 Result := True;
2829 end;
2830
LldbEnvironmentnull2831 function TLldbDebugger.LldbEnvironment(const AVariable: String;
2832 const ASet: Boolean): Boolean;
2833 var
2834 Instr: TLldbInstruction;
2835 s: String;
2836 begin
2837 debugln(DBG_VERBOSE, ['-----------------------------------------', AVariable]);
2838 if ASet then
2839 Instr := TLldbInstructionSettingSet.Create('target.env-vars', AVariable, False, True)
2840 else begin
2841 s := AVariable;
2842 Instr := TLldbInstructionSettingRemove.Create('target.env-vars', GetPart([], ['='], s, False, False));
2843 end;
2844
2845 FDebugInstructionQueue.QueueInstruction(Instr);
2846 Instr.ReleaseReference;
2847 Result := True;
2848 end;
2849
2850 procedure TLldbDebugger.TerminateLldb;
2851 begin
2852 if FDebugProcess.DebugProcessRunning then begin
2853 FDebugProcess.SendCmdLn('process kill');
2854 FDebugProcess.SendCmdLn('quit');
2855 Sleep(100);
2856 end;
2857 FDebugInstructionQueue.OnDebuggerTerminated := nil; // TODO: use a flag to prevent this
2858 FDebugProcess.StopDebugProcess;
2859 FDebugInstructionQueue.OnDebuggerTerminated := @DoCmdLineDebuggerTerminated;
2860 end;
2861
2862 procedure TLldbDebugger.DoBeforeLaunch;
2863 begin
2864 //
2865 end;
2866
2867 procedure TLldbDebugger.DoAfterLaunch(var LaunchWarnings: string);
2868 begin
2869 //
2870 end;
2871
2872 procedure TLldbDebugger.LockRelease;
2873 begin
2874 inherited LockRelease;
2875 end;
2876
2877 procedure TLldbDebugger.UnlockRelease;
2878 begin
2879 inherited UnlockRelease;
2880 end;
2881
2882 procedure TLldbDebugger.QueueCommand(const ACommand: TLldbDebuggerCommand);
2883 begin
2884 FCommandQueue.QueueCommand(ACommand);
2885 end;
2886
2887 procedure TLldbDebugger.SetErrorState(const AMsg: String; const AInfo: String);
2888 begin
2889 inherited SetErrorState(AMsg, AInfo);
2890 end;
2891
2892 procedure TLldbDebugger.DoState(const OldState: TDBGState);
2893 begin
2894 inherited DoState(OldState);
2895 if (State = dsError) then
2896 TerminateLldb;
2897 end;
2898
DoExceptionHitnull2899 function TLldbDebugger.DoExceptionHit(AExcClass, AExcMsg: String): Boolean;
2900 begin
2901 if Assigned(EventLogHandler) then
2902 EventLogHandler.LogCustomEvent(ecDebugger, etExceptionRaised,
2903 Format('Exception class "%s" at $%.' + IntToStr(TargetWidth div 4) + 'x with message "%s"',
2904 [AExcClass, FCurrentLocation.Address, AExcMsg]));
2905
2906 if Assigned(OnException) then
2907 OnException(Self, deInternal, AExcClass, FCurrentLocation, AExcMsg, Result) // TODO: Location
2908 else
2909 Result := True; // CanContinue
2910 end;
2911
DoBreakpointHitnull2912 function TLldbDebugger.DoBreakpointHit(BrkId: Integer): Boolean;
2913 var
2914 BreakPoint: TLldbBreakPoint;
2915 begin
2916 if (BrkId >= 0) then
2917 BreakPoint := TLldbBreakPoints(BreakPoints).FindById(BrkId)
2918 else
2919 BreakPoint := nil;
2920
2921 if Assigned(EventLogHandler) then
2922 EventLogHandler.LogEventBreakPointHit(Breakpoint, FCurrentLocation);
2923
2924 if BreakPoint <> nil then begin
2925 if (BreakPoint.Valid = vsPending) then
2926 BreakPoint.SetPendingToValid(vsValid);
2927
2928 try
2929 BreakPoint.AddReference;
2930
2931 // Important: The Queue must be unlocked
2932 // BreakPoint.Hit may evaluate stack and expressions
2933 // SetDebuggerState may evaluate data for Snapshot
2934 Result := False; // Result;
2935 BreakPoint.Hit(Result);
2936 finally
2937 BreakPoint.ReleaseReference;
2938 end;
2939
2940 end
2941 else
2942 if (State = dsRun)
2943 then begin
2944 debugln(DBG_VERBOSE, ['********** WARNING: breakpoint hit, but nothing known about it ABreakId=', BrkId]);
2945 end;
2946 end;
2947
CreateBreakPointsnull2948 function TLldbDebugger.CreateBreakPoints: TDBGBreakPoints;
2949 begin
2950 Result := TLldbBreakPoints.Create(Self, TLldbBreakPoint);
2951 end;
2952
CreateLocalsnull2953 function TLldbDebugger.CreateLocals: TLocalsSupplier;
2954 begin
2955 Result := TLldbLocals.Create(Self);
2956 end;
2957
CreateRegistersnull2958 function TLldbDebugger.CreateRegisters: TRegisterSupplier;
2959 begin
2960 Result := TLldbRegisterSupplier.Create(Self);
2961 end;
2962
CreateCallStacknull2963 function TLldbDebugger.CreateCallStack: TCallStackSupplier;
2964 begin
2965 Result := TLldbCallStack.Create(Self);
2966 end;
2967
CreateWatchesnull2968 function TLldbDebugger.CreateWatches: TWatchesSupplier;
2969 begin
2970 Result := TLldbWatches.Create(Self);
2971 end;
2972
CreateThreadsnull2973 function TLldbDebugger.CreateThreads: TThreadsSupplier;
2974 begin
2975 Result := TLldbThreads.Create(Self);
2976 end;
2977
GetTargetWidthnull2978 function TLldbDebugger.GetTargetWidth: Byte;
2979 begin
2980 Result := FTargetWidth;
2981 end;
2982
GetIsIdlenull2983 function TLldbDebugger.GetIsIdle: Boolean;
2984 begin
2985 Result := FInIdle or ( (CommandQueue.Count = 0) and (CommandQueue.RunningCommand = nil) );
2986 end;
2987
2988 class function TLldbDebugger.GetSupportedCommands: TDBGCommands;
2989 begin
2990 Result := [dcRun, dcStop, dcStepOver, dcStepInto, dcStepOut, dcEvaluate,
2991 dcStepOverInstr, dcStepIntoInstr, dcPause, dcEnvironment];
2992 // Result := [dcStepTo, dcAttach, dcDetach, dcJumpto,
2993 // dcBreak, dcWatch, dcLocal, dcEvaluate, dcModify,
2994 // dcSetStackFrame, dcDisassemble
2995 // ];
2996 end;
2997
RequestCommandnull2998 function TLldbDebugger.RequestCommand(const ACommand: TDBGCommand;
2999 const AParams: array of const; const ACallback: TMethod): Boolean;
3000 var
3001 EvalFlags: TDBGEvaluateFlags;
3002 begin
3003 LockRelease;
3004 try
3005 case ACommand of
3006 dcRun: Result := LldbRun;
3007 dcPause: Result := LldbPause;
3008 dcStop: Result := LldbStop;
3009 dcStepOver: Result := LldbStep(saOver);
3010 dcStepInto: Result := LldbStep(saInto);
3011 dcStepOut: Result := LldbStep(saOut);
3012 dcStepOverInstr: Result := LldbStep(saInsOver);
3013 dcStepIntoInstr: Result := LldbStep(saInsIn);
3014 dcEvaluate: begin
3015 EvalFlags := [];
3016 if high(AParams) >= 1 then
3017 EvalFlags := TDBGEvaluateFlags(AParams[1].VInteger);
3018 Result := LldbEvaluate(String(AParams[0].VAnsiString),
3019 EvalFlags, TDBGEvaluateResultCallback(ACallback));
3020 end;
3021 // dcStepTo: Result := GDBRunTo(String(AParams[0].VAnsiString), AParams[1].VInteger);
3022 // dcJumpto: Result := GDBJumpTo(String(AParams[0].VAnsiString), AParams[1].VInteger);
3023 // dcAttach: Result := GDBAttach(String(AParams[0].VAnsiString));
3024 // dcDetach: Result := GDBDetach;
3025 // dcModify: Result := GDBModify(String(AParams[0].VAnsiString), String(AParams[1].VAnsiString));
3026 dcEnvironment: Result := LldbEnvironment(String(AParams[0].VAnsiString), AParams[1].VBoolean);
3027 // dcDisassemble: Result := GDBDisassemble(AParams[0].VQWord^, AParams[1].VBoolean, TDbgPtr(AParams[2].VPointer^),
3028 // String(AParams[3].VPointer^), String(AParams[4].VPointer^),
3029 // String(AParams[5].VPointer^), Integer(AParams[6].VPointer^))
3030 // {%H-};
3031 end;
3032 finally
3033 UnlockRelease;
3034 end;
3035 end;
3036
3037 class function TLldbDebugger.CreateProperties: TDebuggerProperties;
3038 begin
3039 Result := TLldbDebuggerProperties.Create;
3040 end;
3041
3042 class function TLldbDebugger.Caption: String;
3043 begin
3044 Result := 'LLDB Debugger (Alpha)';
3045 end;
3046
3047 class function TLldbDebugger.ExePaths: String;
3048 begin
3049 {$IFdef MSWindows}
3050 Result := '';
3051 {$ELSE}
3052 Result := '/usr/bin/lldb';
3053 {$ENDIF}
3054 end;
3055
3056 class function TLldbDebugger.ExePathsMruGroup: TDebuggerClass;
3057 begin
3058 Result := TLldbDebugger;
3059 end;
3060
3061 constructor TLldbDebugger.Create(const AExternalDebugger: String);
3062 begin
3063 inherited Create(AExternalDebugger);
3064 FDebugProcess := TDebugProcess.Create(AExternalDebugger);
3065 FDebugProcess.OnLineSent := @DoLineSentToDbg;
3066
3067 FDebugInstructionQueue := TLldbInstructionQueue.Create(FDebugProcess);
3068 FDebugInstructionQueue.OnBeginLinesReceived := @DoBeginReceivingLines;
3069 FDebugInstructionQueue.OnEndLinesReceived := @DoEndReceivingLines;
3070 FDebugInstructionQueue.OnBeforeHandleLineReceived := @DoBeforeLineReceived;
3071 FDebugInstructionQueue.OnAfterHandleLineReceived := @DoAfterLineReceived;
3072 FDebugInstructionQueue.OnDebuggerTerminated := @DoCmdLineDebuggerTerminated;
3073
3074 FCommandQueue := TLldbDebuggerCommandQueue.Create(Self);
3075
3076 FBreakErrorBreak := TlldbInternalBreakPoint.Create('fpc_break_error', Self, True);
3077 FRunErrorBreak := TlldbInternalBreakPoint.Create('fpc_runerror', Self, True);
3078 FExceptionBreak := TlldbInternalBreakPoint.Create('fpc_raiseexception', Self, True);
3079 FPopExceptStack := TlldbInternalBreakPoint.Create('fpc_popaddrstack', Self);
3080 FCatchesBreak := TlldbInternalBreakPoint.Create('fpc_catches', Self);
3081 FReRaiseBreak := TlldbInternalBreakPoint.Create('fpc_reraise', Self);
3082 end;
3083
3084 destructor TLldbDebugger.Destroy;
3085 begin
3086 debugln(DBG_VERBOSE, ['!!!!!!!!!!!!!!! TLldbDebugger.Destroy ']);
3087 FBreakErrorBreak.Remove;
3088 FRunErrorBreak.Remove;
3089 FExceptionBreak.Remove;
3090 FPopExceptStack.Remove;
3091 FCatchesBreak.Remove;
3092 FReRaiseBreak.Remove;
3093 FDebugInstructionQueue.LockQueueRun;
3094 inherited Destroy;
3095 FBreakErrorBreak.Destroy;
3096 FRunErrorBreak.Destroy;
3097 FExceptionBreak.Destroy;
3098 FPopExceptStack.Destroy;
3099 FCatchesBreak.Destroy;
3100 FReRaiseBreak.Destroy;
3101 FCommandQueue.Destroy;
3102 FDebugInstructionQueue.Destroy;
3103 FDebugProcess.Destroy;
3104 end;
3105
3106 procedure TLldbDebugger.Init;
3107 var
3108 Cmd: TLldbDebuggerCommandInit;
3109 begin
3110 FDebugProcess.CreateDebugProcess('', Environment);
3111 inherited Init;
3112
3113 Cmd := TLldbDebuggerCommandInit.Create(Self);
3114 QueueCommand(Cmd);
3115 Cmd.ReleaseReference;
3116 end;
3117
3118 procedure TLldbDebugger.Done;
3119 begin
3120 DebugLnEnter(DBG_VERBOSE, '!!! TLldbDebugger.Done;');
3121 // TODO: cancel all commands
3122
3123 TerminateLldb;
3124 inherited Done;
3125 DebugLnExit(DBG_VERBOSE, '!!! TLldbDebugger.Done;');
3126 end;
3127
3128 class function TLldbDebugger.RequiredCompilerOpts(ATargetCPU, ATargetOS: String
3129 ): TDebugCompilerRequirements;
3130 begin
3131 Result:=[dcrDwarfOnly];
3132 end;
3133
GetLocationnull3134 function TLldbDebugger.GetLocation: TDBGLocationRec;
3135 begin
3136 Result := FCurrentLocation;
3137 end;
3138
NeedResetnull3139 function TLldbDebugger.NeedReset: Boolean;
3140 begin
3141 Result := true;
3142 end;
3143
3144 procedure TLldbDebugger.TestCmd(const ACommand: String);
3145 begin
3146 FDebugProcess.SendCmdLn(ACommand);
3147 end;
3148
3149 procedure Register;
3150 begin
3151 RegisterDebugger(TLldbDebugger);
3152 end;
3153
3154 initialization
3155 DBG_VERBOSE := DebugLogger.FindOrRegisterLogGroup('DBG_VERBOSE' {$IFDEF DBG_VERBOSE} , True {$ENDIF} );
3156
3157 end.
3158
3159