1 unit FpDbgAvrClasses;
2
3 // Connects to gdbserver instance and communicate over gdb's remote serial protocol (RSP)
4 // in principle possible to connect over any serial text capabile interface such as
5 // tcp/ip, RS-232, pipes etc.
6 // Support only tcp/ip connection for now.
7
8 {$mode objfpc}{$H+}
9 {$packrecords c}
10 {$modeswitch advancedrecords}
11
12 interface
13
14 uses
15 Classes,
16 SysUtils,
17 FpDbgClasses,
18 FpDbgLoader,
19 DbgIntfBaseTypes, DbgIntfDebuggerBase,
20 {$ifdef FORCE_LAZLOGGER_DUMMY} LazLoggerDummy {$else} LazLoggerBase {$endif}, Maps,
21 FpDbgRsp, FpDbgCommon, FpdMemoryTools,
22 FpErrorMessages;
23
24 const
25 // RSP commands
26 Rsp_Status = '?'; // Request break reason - returns either S or T
27 lastCPURegIndex = 31; // After this are SREG, SP and PC
28 SREGindex = 32;
29 SPindex = 33;
30 PCindex = 34;
31 RegArrayLength = 35;
32
33 // Byte level register indexes
34 SPLindex = 33;
35 SPHindex = 34;
36 PC0 = 35;
37 PC1 = 36;
38 PC2 = 37;
39 PC3 = 38;
40 RegArrayByteLength = 39;
41
42 type
43 { TDbgAvrThread }
44
45 TDbgAvrThread = class(TDbgThread)
46 private
47 FRegs: TInitializedRegisters;
48 FRegsUpdated: boolean; // regs read from target
49 //FRegsChanged: boolean; // write regs to target
50 FExceptionSignal: integer;
51 FIsPaused, FInternalPauseRequested, FIsInInternalPause: boolean;
52 FIsSteppingBreakPoint: boolean;
53 FDidResetInstructionPointer: Boolean;
54 FHasThreadState: boolean;
55 function ReadDebugReg(ind: byte; out AVal: TDbgPtr): boolean;
56 function WriteDebugReg(ind: byte; AVal: PtrUInt): boolean;
57
58 // Cache registers if reported in event
59 // Only cache if all reqisters are reported
60 // if not, request registers from target
61 procedure FUpdateStatusFromEvent(event: TStatusEvent);
62 procedure InvalidateRegisters;
63 protected
64 function ReadThreadState: boolean;
65
66 function RequestInternalPause: Boolean;
67 function CheckSignalForPostponing(AWaitedStatus: integer): Boolean;
68 procedure ResetPauseStates;
69 public
70 constructor Create(const AProcess: TDbgProcess; const AID: Integer; const AHandle: THandle); override;
71 function ResetInstructionPointerAfterBreakpoint: boolean; override;
72 procedure ApplyWatchPoints(AWatchPointData: TFpWatchPointData); override;
73 function DetectHardwareWatchpoint: Pointer; override;
74 procedure BeforeContinue; override;
75 procedure LoadRegisterValues; override;
76
77 function GetInstructionPointerRegisterValue: TDbgPtr; override;
78 function GetStackBasePointerRegisterValue: TDbgPtr; override;
79 function GetStackPointerRegisterValue: TDbgPtr; override;
80 end;
81
82 { TDbgAvrProcess }
83
84 TDbgAvrProcess = class(TDbgProcess)
85 private
86 FStatus: integer;
87 FProcessStarted: boolean;
88 FIsTerminating: boolean;
89 // RSP communication
90 FConnection: TRspConnection;
91
92 procedure OnForkEvent(Sender : TObject);
93 protected
94 procedure InitializeLoaders; override;
95 function CreateThread(AthreadIdentifier: THandle; out IsMainThread: boolean): TDbgThread; override;
96 function AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent; override;
97 function CreateWatchPointData: TFpWatchPointData; override;
98 public
99 // TODO: Optional download to target as parameter DownloadExecutable=true
100 //class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings;
101 // AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags): TDbgProcess; override;
102
103 class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings;
104 AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags;
105 AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out AnError: TFpError): TDbgProcess; override;
106
107 // Not supported, returns false
108 //class function AttachToInstance(AFileName: string; APid: Integer
109 // ): TDbgProcess; override;
110 class function AttachToInstance(AFileName: string; APid: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out AnError: TFpError): TDbgProcess; override;
111
112 class function isSupported(target: TTargetDescriptor): boolean; override;
113
114 constructor Create(const AFileName: string; const AProcessID, AThreadID: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager); override;
115 destructor Destroy; override;
116
117 // FOR AVR target AAddress could be program or data (SRAM) memory (or EEPROM)
118 // Gnu tools masks data memory with $800000
119 function ReadData(const AAdress: TDbgPtr; const ASize: Cardinal; out AData): Boolean; override;
120 function WriteData(const AAdress: TDbgPtr; const ASize: Cardinal; const AData): Boolean; override;
121
122 procedure TerminateProcess; override;
123 function Pause: boolean; override;
124 function Detach(AProcess: TDbgProcess; AThread: TDbgThread): boolean; override;
125
126 function Continue(AProcess: TDbgProcess; AThread: TDbgThread; SingleStep: boolean): boolean; override;
127 // Wait for -S or -T response from target, or if connection to target is lost
128 function WaitForDebugEvent(out ProcessIdentifier, ThreadIdentifier: THandle): boolean; override;
129
130 // Insert/Delete break points on target
131 // TODO: if target doesn't support break points or have limited break points
132 // then debugger needs to manage insertion/deletion of break points in target memory
InsertBreakInstructionCodenull133 function InsertBreakInstructionCode(const ALocation: TDBGPtr; out OrigValue: Byte): Boolean; override;
RemoveBreakInstructionCodenull134 function RemoveBreakInstructionCode(const ALocation: TDBGPtr; const OrigValue: Byte): Boolean; override;
135 end;
136
137 // Lets stick with points 4 for now
138
139 { TFpRspWatchPointData }
140
141 TRspBreakWatchPoint = record
142 Owner: Pointer;
143 Address: TDBGPtr;
144 Kind: TDBGWatchPointKind;
145 end;
146
147 TFpRspWatchPointData = class(TFpWatchPointData)
148 private
149 FData: array of TRspBreakWatchPoint;
FBreakWatchPointnull150 function FBreakWatchPoint(AnIndex: Integer): TRspBreakWatchPoint;
FCountnull151 function FCount: integer;
152 public
AddOwnedWatchpointnull153 function AddOwnedWatchpoint(AnOwner: Pointer; AnAddr: TDBGPtr; ASize: Cardinal; AReadWrite: TDBGWatchPointKind): boolean; override;
RemoveOwnedWatchpointnull154 function RemoveOwnedWatchpoint(AnOwner: Pointer): boolean; override;
155 property Data[AnIndex: Integer]: TRspBreakWatchPoint read FBreakWatchPoint;
156 property Count: integer read FCount;
157 end;
158
159 var
160 // Difficult to see how this can be encapsulated except if
161 // added methods are introduced that needs to be called after .Create
162 HostName: string = 'localhost';
163 Port: integer = 12345;
164
165 implementation
166
167 uses
168 FpDbgDisasAvr;
169
170 var
171 DBG_VERBOSE, DBG_WARNINGS: PLazLoggerLogGroup;
172
173 { TFpRspWatchPointData }
174
TFpRspWatchPointData.FBreakWatchPointnull175 function TFpRspWatchPointData.FBreakWatchPoint(AnIndex: Integer
176 ): TRspBreakWatchPoint;
177 begin
178 if AnIndex < length(FData) then
179 result := FData[AnIndex];
180 end;
181
TFpRspWatchPointData.FCountnull182 function TFpRspWatchPointData.FCount: integer;
183 begin
184 result := length(FData);
185 end;
186
TFpRspWatchPointData.AddOwnedWatchpointnull187 function TFpRspWatchPointData.AddOwnedWatchpoint(AnOwner: Pointer;
188 AnAddr: TDBGPtr; ASize: Cardinal; AReadWrite: TDBGWatchPointKind): boolean;
189 var
190 idx: integer;
191 begin
192 Result := false;
193 idx := length(FData);
194 SetLength(FData, idx+1);
195 FData[idx].Address := AnAddr;
196 FData[idx].Kind := AReadWrite;
197 FData[idx].Owner := AnOwner;
198 Changed := true;
199 Result := true;
200 end;
201
RemoveOwnedWatchpointnull202 function TFpRspWatchPointData.RemoveOwnedWatchpoint(AnOwner: Pointer): boolean;
203 var
204 i, j: integer;
205 begin
206 Result := False;
207 i := 0;
208 while (i < length(FData)) and (FData[i].Owner <> AnOwner) do
209 inc(i);
210
211 if i < length(FData) then begin
212 for j := i+1 to length(FData)-1 do begin
213 FData[j-1] := FData[j];
214 Changed := True;
215 Result := True;
216 end;
217
218 SetLength(FData, length(FData)-1);
219 Changed := True;
220 Result := True;
221 end;
222 end;
223
224 { TDbgAvrThread }
225
226 procedure TDbgAvrProcess.OnForkEvent(Sender: TObject);
227 begin
228 end;
229
ReadDebugRegnull230 function TDbgAvrThread.ReadDebugReg(ind: byte; out AVal: TDbgPtr): boolean;
231 begin
232 if TDbgAvrProcess(Process).FIsTerminating or (TDbgAvrProcess(Process).FStatus = SIGHUP) then
233 begin
234 DebugLn(DBG_WARNINGS, 'TDbgRspThread.GetDebugReg called while FIsTerminating is set.');
235 Result := false;
236 end
237 else
238 begin
239 DebugLn(DBG_VERBOSE, ['TDbgRspThread.GetDebugReg requesting register: ',ind]);
240 if FRegs[ind].Initialized then
241 begin
242 AVal := FRegs[ind].Value;
243 result := true;
244 end
245 else
246 begin
247 result := TDbgAvrProcess(Process).FConnection.ReadDebugReg(ind, AVal);
248 FRegs[ind].Value := AVal;
249 FRegs[ind].Initialized := true;
250 end;
251 end;
252 end;
253
TDbgAvrThread.WriteDebugRegnull254 function TDbgAvrThread.WriteDebugReg(ind: byte; AVal: PtrUInt): boolean;
255 begin
256 if TDbgAvrProcess(Process).FIsTerminating or (TDbgAvrProcess(Process).FStatus = SIGHUP) then
257 begin
258 DebugLn(DBG_WARNINGS, 'TDbgRspThread.WriteDebugReg called while FIsTerminating is set.');
259 Result := false;
260 end
261 else
262 result := TDbgAvrProcess(Process).FConnection.WriteDebugReg(ind, AVal);
263 end;
264
265 procedure TDbgAvrThread.FUpdateStatusFromEvent(event: TStatusEvent);
266 var
267 i: integer;
268 begin
269 for i := 0 to high(FRegs) do
270 begin
271 FRegs[i].Initialized := event.registers[i].Initialized;
272 if event.registers[i].Initialized then
273 FRegs[i].Value := event.registers[i].Value;
274 end;
275 end;
276
277 procedure TDbgAvrThread.InvalidateRegisters;
278 var
279 i: integer;
280 begin
281 for i := 0 to high(FRegs) do
282 FRegs[i].Initialized := false;
283 end;
284
TDbgAvrThread.ReadThreadStatenull285 function TDbgAvrThread.ReadThreadState: boolean;
286 begin
287 assert(FIsPaused, 'TDbgRspThread.ReadThreadState: FIsPaused');
288 result := true;
289 if FHasThreadState then
290 exit;
291 FRegisterValueListValid := false;
292 end;
293
RequestInternalPausenull294 function TDbgAvrThread.RequestInternalPause: Boolean;
295 begin
296 if TDbgAvrProcess(Process).FIsTerminating then
297 DebugLn(DBG_WARNINGS, 'TDbgRspThread.RequestInternalPause called while FIsTerminating is set.');
298
299 Result := False;
300 if FInternalPauseRequested or FIsPaused or (TDbgAvrProcess(Process).FStatus = SIGHUP) then
301 exit;
302
303 DebugLn(DBG_VERBOSE, 'TDbgRspThread.RequestInternalPause requesting Ctrl-C.');
304
305 FInternalPauseRequested := true;
306 // Send SIGSTOP/break
307 TDbgAvrProcess(Process).FConnection.Break();
308 end;
309
CheckSignalForPostponingnull310 function TDbgAvrThread.CheckSignalForPostponing(AWaitedStatus: integer): Boolean;
311 begin
312 Assert(not FIsPaused, 'Got WaitStatus while already paused');
313 assert(FExceptionSignal = 0, 'TDbgLinuxThread.CheckSignalForPostponing: FExceptionSignal = 0');
314 Result := FIsPaused;
315 DebugLn(DBG_VERBOSE and (Result), ['Warning: Thread already paused', ID]);
316
317 DebugLn(DBG_VERBOSE, ['TDbgRspThread.CheckSignalForPostponing called with ', AWaitedStatus]);
318
319 if Result then
320 exit;
321
322 FIsPaused := True;
323 FIsInInternalPause := False;
324 end;
325
326 procedure TDbgAvrThread.ResetPauseStates;
327 begin
328 FIsInInternalPause := False;
329 FIsPaused := False;
330 FExceptionSignal := 0;
331 FHasThreadState := False;
332 FDidResetInstructionPointer := False;
333 end;
334
335 constructor TDbgAvrThread.Create(const AProcess: TDbgProcess;
336 const AID: Integer; const AHandle: THandle);
337 begin
338 inherited;
339 SetLength(FRegs, RegArrayLength);
340 end;
341
TDbgAvrThread.ResetInstructionPointerAfterBreakpointnull342 function TDbgAvrThread.ResetInstructionPointerAfterBreakpoint: boolean;
343 begin
344 if not ReadThreadState then
345 exit(False);
346 result := true;
347 if FDidResetInstructionPointer then
348 exit;
349 FDidResetInstructionPointer := True;
350
351 // This is not required for gdbserver
352 // since remote stub should ensure PC points to break address
353 //Dec(FRegs.cpuRegs[PCindex]);
354 //FRegsChanged:=true;
355 end;
356
357 procedure TDbgAvrThread.ApplyWatchPoints(AWatchPointData: TFpWatchPointData);
358 var
359 i: integer;
360 r: boolean;
361 addr: PtrUInt;
362 begin
363 // Skip this for now...
364 exit;
365
366 // TODO: Derive a custom class from TFpWatchPointData to manage
367 // break/watchpoints and communicate over rsp
368 r := True;
369 for i := 0 to TFpRspWatchPointData(AWatchPointData).Count-1 do begin // TODO: make size dynamic
370 addr := PtrUInt(TFpRspWatchPointData(AWatchPointData).Data[i].Address);
371
372 r := r and WriteDebugReg(i, addr);
373 end;
374 end;
375
TDbgAvrThread.DetectHardwareWatchpointnull376 function TDbgAvrThread.DetectHardwareWatchpoint: Pointer;
377 begin
378 result := nil;
379 end;
380
381 procedure TDbgAvrThread.BeforeContinue;
382 //var
383 // regs: TBytes;
384 begin
385 if not FIsPaused then
386 exit;
387
388 inherited;
389 InvalidateRegisters;
390
391 // TODO: currently nothing changes registers locally?
392
393 // Update registers if changed locally
394 //if FRegsChanged then
395 //begin
396 // SetLength(regs, RegArrayByteLength);
397 // for i := 0 to lastCPURegIndex do
398 // regs[i] :=
399 // FRegsChanged:=false;
400 //end;
401 end;
402
403 procedure TDbgAvrThread.LoadRegisterValues;
404 var
405 i: integer;
406 regs: TBytes;
407 begin
408 if TDbgAvrProcess(Process).FIsTerminating or (TDbgAvrProcess(Process).FStatus = SIGHUP) then
409 begin
410 DebugLn(DBG_WARNINGS, 'TDbgRspThread.LoadRegisterValues called while FIsTerminating is set.');
411 exit;
412 end;
413
414 if not ReadThreadState then
415 exit;
416
417 if not FRegsUpdated then
418 begin
419 SetLength(regs, RegArrayByteLength);
420 FRegsUpdated := TDbgAvrProcess(Process).FConnection.ReadRegisters(regs[0], length(regs));
421 // repack according to target endianness
422 FRegs[SPindex].Value := regs[SPLindex] + (regs[SPHindex] shl 8);
423 FRegs[SPHindex].Initialized := true;
424 FRegs[PCindex].Value := regs[PC0] + (regs[PC1] shl 8) + (regs[PC2] shl 16) + (regs[PC3] shl 24);
425 FRegs[PCindex].Initialized := true;
426 end;
427
428 if FRegsUpdated then
429 begin
430 for i := 0 to lastCPURegIndex do
431 FRegisterValueList.DbgRegisterAutoCreate['r'+IntToStr(i)].SetValue(FRegs[i].Value, IntToStr(FRegs[i].Value),1, i); // confirm dwarf index
432
433 FRegisterValueList.DbgRegisterAutoCreate['sreg'].SetValue(FRegs[SREGindex].Value, IntToStr(FRegs[SREGindex].Value),1,0);
434 FRegisterValueList.DbgRegisterAutoCreate['sp'].SetValue(FRegs[SPindex].Value, IntToStr(FRegs[SPindex].Value),2,0);
435 FRegisterValueList.DbgRegisterAutoCreate['pc'].SetValue(FRegs[PCindex].Value, IntToStr(FRegs[PCindex].Value),4,0);
436 FRegisterValueListValid := true;
437 end
438 else
439 DebugLn(DBG_WARNINGS, 'Warning: Could not update registers');
440 end;
441
TDbgAvrThread.GetInstructionPointerRegisterValuenull442 function TDbgAvrThread.GetInstructionPointerRegisterValue: TDbgPtr;
443 begin
444 Result := 0;
445 if TDbgAvrProcess(Process).FIsTerminating then
446 begin
447 DebugLn(DBG_WARNINGS, 'TDbgRspThread.GetInstructionPointerRegisterValue called while FIsTerminating is set.');
448 exit;
449 end;
450
451 if not ReadThreadState then
452 exit;
453
454 DebugLn(DBG_VERBOSE, 'TDbgRspThread.GetInstructionPointerRegisterValue requesting PC.');
455 ReadDebugReg(PCindex, result);
456 end;
457
TDbgAvrThread.GetStackBasePointerRegisterValuenull458 function TDbgAvrThread.GetStackBasePointerRegisterValue: TDbgPtr;
459 var
460 lval, hval: QWord;
461 begin
462 Result := 0;
463 if TDbgAvrProcess(Process).FIsTerminating then
464 begin
465 DebugLn(DBG_WARNINGS, 'TDbgAvrThread.GetStackBasePointerRegisterValue called while FIsTerminating is set.');
466 exit;
467 end;
468
469 if not ReadThreadState then
470 exit;
471
472 DebugLn(DBG_VERBOSE, 'TDbgAvrThread.GetStackBasePointerRegisterValue requesting base registers.');
473 // Y-pointer (r28..r29)
474 ReadDebugReg(28, lval);
475 ReadDebugReg(29, hval);
476 result := byte(lval) + (byte(hval) shl 8);
477 end;
478
TDbgAvrThread.GetStackPointerRegisterValuenull479 function TDbgAvrThread.GetStackPointerRegisterValue: TDbgPtr;
480 begin
481 Result := 0;
482 if TDbgAvrProcess(Process).FIsTerminating then
483 begin
484 DebugLn(DBG_WARNINGS, 'TDbgRspThread.GetStackPointerRegisterValue called while FIsTerminating is set.');
485 exit;
486 end;
487
488 if not ReadThreadState then
489 exit;
490
491 DebugLn(DBG_VERBOSE, 'TDbgRspThread.GetStackPointerRegisterValue requesting stack registers.');
492 ReadDebugReg(SPindex, result);
493 end;
494
495 { TDbgAvrProcess }
496
497 procedure TDbgAvrProcess.InitializeLoaders;
498 begin
499 TDbgImageLoader.Create(Name).AddToLoaderList(LoaderList);
500 end;
501
CreateThreadnull502 function TDbgAvrProcess.CreateThread(AthreadIdentifier: THandle; out IsMainThread: boolean): TDbgThread;
503 begin
504 IsMainThread:=False;
505 if AthreadIdentifier<>feInvalidHandle then
506 begin
507 IsMainThread := AthreadIdentifier=ProcessID;
508 result := TDbgAvrThread.Create(Self, AthreadIdentifier, AthreadIdentifier)
509 end
510 else
511 result := nil;
512 end;
513
CreateWatchPointDatanull514 function TDbgAvrProcess.CreateWatchPointData: TFpWatchPointData;
515 begin
516 DebugLn(DBG_VERBOSE, 'TDbgRspProcess.CreateWatchPointData called.');
517 Result := TFpRspWatchPointData.Create;
518 end;
519
520 constructor TDbgAvrProcess.Create(const AFileName: string; const AProcessID,
521 AThreadID: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager
522 );
523 begin
524 inherited Create(AFileName, AProcessID, AThreadID, AnOsClasses, AMemManager);
525 end;
526
527 destructor TDbgAvrProcess.Destroy;
528 begin
529 if Assigned(FConnection) then
530 FreeAndNil(FConnection);
531 inherited Destroy;
532 end;
533
TDbgAvrProcess.StartInstancenull534 class function TDbgAvrProcess.StartInstance(AFileName: string; AParams,
535 AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string;
536 AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses;
537 AMemManager: TFpDbgMemManager; out AnError: TFpError): TDbgProcess;
538 var
539 AnExecutabeFilename: string;
540 dbg: TDbgAvrProcess;
541 begin
542 result := nil;
543
544 AnExecutabeFilename:=ExcludeTrailingPathDelimiter(AFileName);
545 if DirectoryExists(AnExecutabeFilename) then
546 begin
547 DebugLn(DBG_WARNINGS, 'Can not debug %s, because it''s a directory',[AnExecutabeFilename]);
548 Exit;
549 end;
550
551 if not FileExists(AFileName) then
552 begin
553 DebugLn(DBG_WARNINGS, 'Can not find %s.',[AnExecutabeFilename]);
554 Exit;
555 end;
556
557 dbg := TDbgAvrProcess.Create(AFileName, 0, 0, AnOsClasses, AMemManager);
558 try
559 dbg.FConnection := TRspConnection.Create(HostName, Port);
560 dbg.FConnection.RegisterCacheSize := RegArrayLength;
561 result := dbg;
562 dbg.FStatus := dbg.FConnection.Init;
563 dbg := nil;
564 except
565 on E: Exception do
566 begin
567 if Assigned(dbg) then
568 dbg.Free;
569 DebugLn(DBG_WARNINGS, Format('Failed to start remote connection. Errormessage: "%s".', [E.Message]));
570 end;
571 end;
572 end;
573
TDbgAvrProcess.AttachToInstancenull574 class function TDbgAvrProcess.AttachToInstance(AFileName: string;
575 APid: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out
576 AnError: TFpError): TDbgProcess;
577 begin
578 result := nil;
579 end;
580
TDbgAvrProcess.isSupportednull581 class function TDbgAvrProcess.isSupported(target: TTargetDescriptor): boolean;
582 begin
583 result := (target.OS = osEmbedded) and
584 (target.machineType = mtAVR8);
585 end;
586
TDbgAvrProcess.ReadDatanull587 function TDbgAvrProcess.ReadData(const AAdress: TDbgPtr;
588 const ASize: Cardinal; out AData): Boolean;
589 begin
590 if FIsTerminating or (TDbgAvrProcess(Process).FStatus = SIGHUP) then
591 begin
592 DebugLn(DBG_WARNINGS, 'TDbgRspProcess.ReadData called while FIsTerminating is set.');
593 Result := false;
594 exit;
595 end;
596
597 result := FConnection.ReadData(AAdress, ASize, AData);
598 MaskBreakpointsInReadData(AAdress, ASize, AData);
599 end;
600
TDbgAvrProcess.WriteDatanull601 function TDbgAvrProcess.WriteData(const AAdress: TDbgPtr;
602 const ASize: Cardinal; const AData): Boolean;
603 begin
604 if FIsTerminating or (TDbgAvrProcess(Process).FStatus = SIGHUP) then
605 begin
606 DebugLn(DBG_WARNINGS, 'TDbgRspProcess.WriteData called while FIsTerminating is set.');
607 Result := false;
608 exit;
609 end;
610
611 result := FConnection.WriteData(AAdress,AAdress, AData);
612 end;
613
614 procedure TDbgAvrProcess.TerminateProcess;
615 begin
616 // Try to prevent access to the RSP socket after it has been closed
617 if not (FIsTerminating or (TDbgAvrProcess(Process).FStatus = SIGHUP)) then
618 begin
619 DebugLn(DBG_VERBOSE, 'Removing all break points');
620 RemoveAllBreakPoints;
621 DebugLn(DBG_VERBOSE, 'Sending kill command from TDbgRspProcess.TerminateProcess');
622 FConnection.Kill();
623 FIsTerminating:=true;
624 end;
625 end;
626
Pausenull627 function TDbgAvrProcess.Pause: boolean;
628 begin
629 if FIsTerminating or (TDbgAvrProcess(Process).FStatus = SIGHUP) then
630 begin
631 DebugLn(DBG_WARNINGS, 'TDbgRspProcess.Pause called while FIsTerminating is set.');
632 Result := false;
633 exit;
634 end;
635
636 // Target should automatically respond with T or S reply after processing the break
637 result := true;
638 if not PauseRequested then
639 begin
640 FConnection.Break();
641 PauseRequested := true;
642 DebugLn(DBG_VERBOSE, 'TDbgRspProcess.Pause called.');
643 end
644 else
645 begin
646 result := true;
647 DebugLn(DBG_WARNINGS, 'TDbgRspProcess.Pause called while PauseRequested is set.');
648 end;
649 end;
650
Detachnull651 function TDbgAvrProcess.Detach(AProcess: TDbgProcess; AThread: TDbgThread): boolean;
652 begin
653 RemoveAllBreakPoints;
654 DebugLn(DBG_VERBOSE, 'Sending detach command from TDbgRspProcess.Detach');
655 Result := FConnection.Detach();
656 end;
657
TDbgAvrProcess.Continuenull658 function TDbgAvrProcess.Continue(AProcess: TDbgProcess; AThread: TDbgThread; SingleStep: boolean): boolean;
659 var
660 ThreadToContinue: TDbgAvrThread;
661 PC: word;
662 s: string;
663 tempState: integer;
664 initRegs: TInitializedRegisters;
665 begin
666 // Terminating process and all threads
667 if FIsTerminating or (FStatus = SIGHUP) then
668 begin
669 AThread.BeforeContinue;
670 TDbgAvrThread(AThread).InvalidateRegisters;
671 DebugLn(DBG_VERBOSE, 'TDbgRspProcess.Continue called while terminating.');
672
673 // The kill command should have been issued earlier (if using fpd), calling SendKill again will lead to an exception since the connection should be terminated already.
674 // FConnection.Kill();
675
676 TDbgAvrThread(AThread).ResetPauseStates;
677 if not FThreadMap.HasId(AThread.ID) then
678 AThread.Free;
679 exit;
680 end;
681
682 if TDbgAvrThread(AThread).FIsPaused then // in case of deInternal, it may not be paused and can be ignored
683 AThread.NextIsSingleStep:=SingleStep;
684
685 // check other threads if they need a singlestep
686 for TDbgThread(ThreadToContinue) in FThreadMap do
687 if (ThreadToContinue <> AThread) and ThreadToContinue.FIsPaused then
688 begin
689 PC := ThreadToContinue.GetInstructionPointerRegisterValue;
690 if HasInsertedBreakInstructionAtLocation(PC) then
691 begin
692 TempRemoveBreakInstructionCode(PC);
693 ThreadToContinue.BeforeContinue;
694
695 while (ThreadToContinue.GetInstructionPointerRegisterValue = PC) do
696 begin
697 result := FConnection.SingleStep();
698 TDbgAvrThread(ThreadToContinue).ResetPauseStates; // So BeforeContinue will not run again
699 ThreadToContinue.FIsPaused := True;
700 if result then
701 begin
702 tempState := FConnection.WaitForSignal(s, initRegs); // TODO: Update registers cache for this thread
703 if (tempState = SIGTRAP) then
704 break; // if the command jumps back an itself....
705 end
706 else
707 begin
708 DebugLn(DBG_WARNINGS, ['Error single stepping other thread ', ThreadToContinue.ID]);
709 break;
710 end;
711 end;
712 end;
713 end;
714
715 if TDbgAvrThread(AThread).FIsPaused then // in case of deInternal, it may not be paused and can be ignored
716 if HasInsertedBreakInstructionAtLocation(AThread.GetInstructionPointerRegisterValue) then
717 begin
718 TempRemoveBreakInstructionCode(AThread.GetInstructionPointerRegisterValue);
719 TDbgAvrThread(AThread).FIsSteppingBreakPoint := True;
720 AThread.BeforeContinue;
721 result := FConnection.SingleStep(); // TODO: pass thread ID once it is supported in FConnection - also signals not yet passed through
722 TDbgAvrThread(AThread).ResetPauseStates;
723 FStatus := 0; // need to call WaitForSignal to read state after single step
724 exit;
725 end;
726
727 RestoreTempBreakInstructionCodes;
728
729 ThreadsBeforeContinue;
730
731 // start all other threads
732 for TDbgThread(ThreadToContinue) in FThreadMap do
733 begin
734 if (ThreadToContinue <> AThread) and (ThreadToContinue.FIsPaused) then
735 begin
736 FConnection.Continue();
737 ThreadToContinue.ResetPauseStates;
738 end;
739 end;
740
741 if TDbgAvrThread(AThread).FIsPaused then // in case of deInternal, it may not be paused and can be ignored
742 if not FIsTerminating then
743 begin
744 AThread.BeforeContinue;
745 if SingleStep then
746 result := FConnection.SingleStep()
747 else
748 result := FConnection.Continue();
749 TDbgAvrThread(AThread).ResetPauseStates;
750 FStatus := 0; // should update status by calling WaitForSignal
751 end;
752
753 if not FThreadMap.HasId(AThread.ID) then
754 AThread.Free;
755 end;
756
TDbgAvrProcess.WaitForDebugEventnull757 function TDbgAvrProcess.WaitForDebugEvent(out ProcessIdentifier, ThreadIdentifier: THandle): boolean;
758 var
759 s: string;
760 initRegs: TInitializedRegisters;
761 begin
762 debugln(DBG_VERBOSE, ['Entering WaitForDebugEvent, FStatus = ', FStatus]);
763 // Currently only single process/thread
764 // TODO: Query and handle process/thread states of target
765 ThreadIdentifier := self.ThreadID;
766 ProcessIdentifier := Self.ProcessID;
767
768 if FIsTerminating then
769 begin
770 DebugLn(DBG_VERBOSE, 'TDbgRspProcess.WaitForDebugEvent called while FIsTerminating is set.');
771 FStatus := SIGKILL;
772 end
773 else
774 // Wait for S or T response from target, or if connection to target is lost
775 if FStatus = 0 then
776 repeat
777 try
778 FStatus := FConnection.WaitForSignal(s, initRegs); // TODO: Update registers cache
779 except
780 FStatus := 0;
781 end;
782 until FStatus <> 0; // should probably wait at lower level...
783
784 if FStatus <> 0 then
785 begin
786 if FStatus in [SIGINT, SIGTRAP] then
787 begin
788 RestoreTempBreakInstructionCodes;
789 end;
790 end;
791
792 result := true;
793 end;
794
TDbgAvrProcess.InsertBreakInstructionCodenull795 function TDbgAvrProcess.InsertBreakInstructionCode(const ALocation: TDBGPtr;
796 out OrigValue: Byte): Boolean;
797 begin
798 if FIsTerminating or (FStatus = SIGHUP) then
799 DebugLn(DBG_WARNINGS, 'TDbgRspProcess.InsertBreakInstruction called while FIsTerminating is set.');
800
801 result := ReadData(ALocation, SizeOf(OrigValue), OrigValue);
802 if result then
803 begin
804 // HW break...
805 result := FConnection.SetBreakWatchPoint(ALocation, wkpExec);
806 if not result then
807 DebugLn(DBG_WARNINGS, 'Failed to set break point.', []);
808 end
809 else
810 DebugLn(DBG_WARNINGS, 'Failed to read memory.', []);
811 end;
812
TDbgAvrProcess.RemoveBreakInstructionCodenull813 function TDbgAvrProcess.RemoveBreakInstructionCode(const ALocation: TDBGPtr;
814 const OrigValue: Byte): Boolean;
815 begin
816 if FIsTerminating or (FStatus = SIGHUP) then
817 begin
818 DebugLn(DBG_WARNINGS, 'TDbgRspProcess.RemoveBreakInstructionCode called while FIsTerminating is set');
819 result := false;
820 end
821 else
822 result := FConnection.DeleteBreakWatchPoint(ALocation, wkpExec);
823 end;
824
AnalyseDebugEventnull825 function TDbgAvrProcess.AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent;
826 var
827 ThreadToPause: TDbgAvrThread;
828 begin
829 debugln(DBG_VERBOSE, ['Entering TDbgRspProcess.AnalyseDebugEvent, FStatus = ', FStatus, ' PauseRequested = ', PauseRequested]);
830 if FIsTerminating then begin
831 result := deExitProcess;
832 exit;
833 end;
834
835 if AThread = nil then begin // should not happen... / just assume the most likely safe failbacks
836 result := deInternalContinue;
837 exit;
838 end;
839
840 TDbgAvrThread(AThread).FExceptionSignal:=0;
841 TDbgAvrThread(AThread).FIsPaused := True;
842 TDbgAvrThread(AThread).FUpdateStatusFromEvent(FConnection.lastStatusEvent);
843
844 if FStatus in [SIGHUP, SIGKILL] then // not sure which signals is relevant here
845 begin
846 if AThread.ID=ProcessID then
847 begin
848 // Main thread stop -> application exited
849 SetExitCode(FStatus);
850 result := deExitProcess
851 end
852 else
853 begin
854 // Thread stopped, just continue
855 RemoveThread(AThread.Id);
856 result := deInternalContinue;
857 end;
858 end
859 else if FStatus <> 0 then
860 begin
861 TDbgAvrThread(AThread).ReadThreadState;
862
863 if (not FProcessStarted) and (FStatus <> SIGTRAP) then
864 begin
865 // attached, should be SigStop, but may be out of order
866 debugln(DBG_VERBOSE, ['Attached ', FStatus]);
867 result := deCreateProcess;
868 FProcessStarted:=true;
869 end
870 else
871 case FStatus of
872 SIGTRAP:
873 begin
874 if not FProcessStarted then
875 begin
876 result := deCreateProcess;
877 FProcessStarted:=true;
878 DebugLn(DBG_VERBOSE, ['Creating process - SIGTRAP received for thread: ', AThread.ID]);
879 end
880 else if TDbgAvrThread(AThread).FInternalPauseRequested then
881 begin
882 DebugLn(DBG_VERBOSE, ['???Received late SigTrap for thread ', AThread.ID]);
883 result := deBreakpoint;//deInternalContinue; // left over signal
884 end
885 else
886 begin
887 DebugLn(DBG_VERBOSE, ['Received SigTrap for thread ', AThread.ID,
888 ' PauseRequest=', PauseRequested]);
889 if PauseRequested then // Hack to work around Pause problem
890 result := deFinishedStep
891 else
892 result := deBreakpoint;
893
894 if not TDbgAvrThread(AThread).FIsSteppingBreakPoint then
895 AThread.CheckAndResetInstructionPointerAfterBreakpoint;
896 end;
897 end;
898 SIGINT:
899 begin
900 ExceptionClass:='SIGINT';
901 TDbgAvrThread(AThread).FExceptionSignal:=SIGINT;
902 result := deException;
903 end;
904 SIGKILL:
905 begin
906 if FIsTerminating then
907 result := deInternalContinue
908 else
909 begin
910 ExceptionClass:='SIGKILL';
911 TDbgAvrThread(AThread).FExceptionSignal:=SIGKILL;
912 result := deException;
913 end;
914 end;
915 SIGSTOP:
916 begin
917 // New thread (stopped within the new thread)
918 result := deInternalContinue;
919 end
920 else
921 begin
922 ExceptionClass:='Unknown exception code ' + inttostr(FStatus);
923 TDbgAvrThread(AThread).FExceptionSignal := FStatus;
924 result := deException;
925 end;
926 end; {case}
927 if result=deException then
928 ExceptionClass:='External: '+ExceptionClass;
929 end;
930
931 debugln(DBG_VERBOSE, ['Leaving AnalyseDebugEvent, result = ', result]);
932
933 TDbgAvrThread(AThread).FIsSteppingBreakPoint := False;
934
935 if Result in [deException, deBreakpoint, deFinishedStep] then // deFinishedStep will not be set here
936 begin
937 // Signal all other threads to pause
938 for TDbgThread(ThreadToPause) in FThreadMap do
939 begin
940 if (ThreadToPause <> AThread) then
941 begin
942 DebugLn(DBG_VERBOSE and (ThreadToPause.FInternalPauseRequested), ['Re-Request Internal pause for ', ThreadToPause.ID]);
943 ThreadToPause.FInternalPauseRequested:=false;
944 if not ThreadToPause.RequestInternalPause then // will fail, if already paused
945 break;
946 end;
947 end;
948 end;
949 end;
950
951 initialization
952 DBG_VERBOSE := DebugLogger.FindOrRegisterLogGroup('DBG_VERBOSE' {$IFDEF DBG_VERBOSE} , True {$ENDIF} );
953 DBG_WARNINGS := DebugLogger.FindOrRegisterLogGroup('DBG_WARNINGS' {$IFDEF DBG_WARNINGS} , True {$ENDIF} );
954 RegisterDbgOsClasses(TOSDbgClasses.Create(
955 TDbgAvrProcess,
956 TDbgAvrThread,
957 TAvrAsmDecoder));
958 end.
959