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