1 { $Id: fpdcommand.pas 54031 2017-01-29 21:04:32Z joost $ }
2 {
3 ---------------------------------------------------------------------------
4 fpdcommand.pas - FP standalone debugger - Command interpreter
5 ---------------------------------------------------------------------------
6
7 This unit contains handles all debugger commands
8
9 ---------------------------------------------------------------------------
10
11 @created(Mon Apr 10th WET 2006)
12 @lastmod($Date: 2017-01-29 22:04:32 +0100 (So, 29 Jan 2017) $)
13 @author(Marc Weustink <marc@@dommelstein.nl>)
14
15 ***************************************************************************
16 * *
17 * This source is free software; you can redistribute it and/or modify *
18 * it under the terms of the GNU General Public License as published by *
19 * the Free Software Foundation; either version 2 of the License, or *
20 * (at your option) any later version. *
21 * *
22 * This code is distributed in the hope that it will be useful, but *
23 * WITHOUT ANY WARRANTY; without even the implied warranty of *
24 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
25 * General Public License for more details. *
26 * *
27 * A copy of the GNU General Public License is available on the World *
28 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
29 * obtain it by writing to the Free Software Foundation, *
30 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
31 * *
32 ***************************************************************************
33 }
34 unit FPDCommand;
35 {$mode objfpc}{$H+}
36 interface
37
38 uses
39 SysUtils, Classes,
40 {$ifdef windows}
41 Windows,
42 {$endif}
43 LCLProc, FpDbgInfo, FpDbgClasses, DbgIntfBaseTypes, FpDbgUtil, CustApp,
44 FpPascalParser,
45 FPDbgController,
46 FpPascalBuilder,
47 FpErrorMessages;
48
49 procedure HandleCommand(ACommand: String; out CallProcessLoop: boolean);
50
51 implementation
52
53 uses
54 FPDGlobal
55 {$ifdef windows}
56 , FPDPEImage
57 {$endif windows}
58 ;
59
60 type
61 TFPDCommandHandler = procedure(AParams: String; out CallProcessLoop: boolean);
62
63 TFPDCommand = class
64 private
65 FCommand: String;
66 FHandler: TFPDCommandHandler;
67 FHelp: String;
68 public
69 constructor Create(const AHandler: TFPDCommandHandler; const ACommand, AHelp: String);
70 property Command: String read FCommand;
71 property Handler: TFPDCommandHandler read FHandler;
72 property Help: String read FHelp;
73 end;
74
75 { TFPDCommandList }
76
77 TFPDCommandList = class
78 private
79 FCommands: TStringList;
GetItemnull80 function GetItem(const AIndex: Integer): TFPDCommand;
81 public
82 procedure AddCommand(const ACommands: array of String; const AHandler: TFPDCommandHandler; const AHelp: String);
Countnull83 function Count: Integer;
84 constructor Create;
85 destructor Destroy; override;
FindCommandnull86 function FindCommand(const ACommand: String): TFPDCommand;
87 procedure HandleCommand(ACommand: String; out CallProcessLoop: boolean);
88 property Items[const AIndex: Integer]: TFPDCommand read GetItem; default;
89 end;
90
91
92 var
93 MCommands: TFPDCommandList;
94 MShowCommands: TFPDCommandList;
95 MSetCommands: TFPDCommandList;
96
97 resourcestring
98 sAddBreakpoint = 'Breakpoint added at address %s.';
99 sAddBreakpointFailed = 'Adding breakpoint at %s failed.';
100 sRemoveBreakpoint = 'Breakpoint removed from address %s.';
101 sRemoveBreakpointFailed = 'Removing breakpoint at %s failed.';
102
103 procedure HandleCommand(ACommand: String; out CallProcessLoop: boolean);
104 begin
105 MCommands.HandleCommand(ACommand, CallProcessLoop);
106 end;
107
108
109 procedure HandleHelp(AParams: String; out CallProcessLoop: boolean);
110 var
111 n: Integer;
112 cmd: TFPDCommand;
113 begin
114 CallProcessLoop:=false;
115 if AParams = ''
116 then begin
117 WriteLN('Available commands:');
118 for n := 0 to MCommands.Count - 1 do
119 WriteLN(' ', MCommands[n].Command);
120 end
121 else begin
122 cmd := MCommands.FindCommand(AParams);
123 if cmd = nil
124 then WriteLN('Unknown command: "', AParams, '"')
125 else WriteLN(cmd.Help);
126 end;
127 end;
128
129 procedure HandleFile(AParams: String; out CallProcessLoop: boolean);
130 begin
131 if AParams <> ''
132 then GController.ExecutableFilename := AParams;
133
134 CallProcessLoop:=false;
135 // TODO separate exec from args
136 end;
137
138 procedure HandleShow(AParams: String; out CallProcessLoop: boolean);
139 var
140 cmd: TFPDCommand;
141 S: String;
142 begin
143 CallProcessLoop:=false;
144 S := GetPart([], [' ', #9], AParams);
145 if S = '' then S := 'help';
146 cmd := MShowCommands.FindCommand(S);
147 if cmd = nil
148 then WriteLN('Unknown item: "', S, '"')
149 else cmd.Handler(Trim(AParams), CallProcessLoop);
150 end;
151
152 procedure HandleSet(AParams: String; out CallProcessLoop: boolean);
153 var
154 cmd: TFPDCommand;
155 S: String;
156 begin
157 S := GetPart([], [' ', #9], AParams);
158 if S = '' then S := 'help';
159 cmd := MSetCommands.FindCommand(S);
160 if cmd = nil
161 then WriteLN('Unknown param: "', S, '"')
162 else cmd.Handler(Trim(AParams), CallProcessLoop);
163 end;
164
165 procedure HandleRun(AParams: String; out CallProcessLoop: boolean);
166 var
167 AParamList: TStringList;
168 begin
169 CallProcessLoop:=false;
170 if Assigned(GController.MainProcess)
171 then begin
172 WriteLN('The debuggee is already running');
173 Exit;
174 end;
175
176 if GController.ExecutableFilename = ''
177 then begin
178 WriteLN('No filename set');
179 Exit;
180 end;
181
182 if AParams<>'' then begin
183 AParamList := TStringList.Create;
184 try
185 AParamList.Text:=AParams;
186 GController.Params.Assign(AParamList);
187 finally
188 AParamList.free;
189 end;
190 end;
191
192 if not GController.Run then
193 writeln('Failed to run '+GController.ExecutableFilename)
194 else
195 CallProcessLoop:=true;
196 end;
197
198 procedure HandleBreak(AParams: String; out CallProcessLoop: boolean);
199 var
200 S, P: String;
201 Remove: Boolean;
202 Address: TDbgPtr;
203 e: Integer;
204 Line: Cardinal;
205 bp: TDbgBreakpoint;
206
207 AContext: TFpDbgInfoContext;
208 AValue: TFpDbgValue;
209
210 begin
211 CallProcessLoop:=false;
212 if GController.MainProcess = nil
213 then begin
214 WriteLN('No Process');
215 Exit;
216 end;
217
218 S := AParams;
219 P := GetPart([], [' ', #9], S);
220 Remove := P = '-d';
221 if not Remove
222 then S := P;
223
224 if S = ''
225 then begin
226 // current addr
227 P := '';
228 Address := GController.CurrentProcess.GetInstructionPointerRegisterValue;
229 end
230 else begin
231 P := GetPart([], [':'], S);
232 end;
233
234 if S = ''
235 then begin
236 if P <> ''
237 then begin
238 // address given
239 Val(P, Address, e);
240 if e <> 0
241 then begin
242 AContext := GController.CurrentProcess.SymbolTableInfo.FindContext(GController.CurrentProcess.GetInstructionPointerRegisterValue);
243 if AContext = nil then begin
244 Writeln('Invalid context');
245 exit;
246 end;
247 AValue := AContext.FindSymbol(P);
248 if not assigned(AValue) then begin
249 WriteLN('Illegal address/unknown symbol: ', P);
250 Exit;
251 end;
252 Address:=AValue.Address.Address;
253 end;
254 end;
255 if Remove
256 then begin
257 if GController.CurrentProcess.RemoveBreak(Address)
258 then WriteLn(format(sRemoveBreakpoint,[FormatAddress(Address)]))
259 else WriteLn(Format(sRemoveBreakpointFailed, [FormatAddress(Address)]));
260 end
261 else begin
262 if GController.CurrentProcess.AddBreak(Address) <> nil
263 then WriteLn(format(sAddBreakpoint, [FormatAddress(Address)]))
264 else WriteLn(Format(sAddBreakpointFailed, [FormatAddress(Address)]));
265 end;
266 end
267 else begin
268 S := GetPart([':'], [], S);
269 Val(S, Line, e);
270 if e <> 0
271 then begin
272 WriteLN('Illegal line: ', S);
273 Exit;
274 end;
275 if Remove
276 then begin
277 if TDbgInstance(GController.CurrentProcess).RemoveBreak(P, Line)
278 then WriteLn('breakpoint removed')
279 else WriteLn('remove breakpoint failed');
280 Exit;
281 end;
282
283 bp := TDbgInstance(GController.CurrentProcess).AddBreak(P, Line);
284 if bp = nil
285 then begin
286 WriteLn(Format(sAddBreakpointFailed, [S]));
287 Exit;
288 end;
289
290 WriteLn(format(sAddBreakpoint, [FormatAddress(bp.Location)]))
291 end;
292 end;
293
294 procedure HandleContinue(AParams: String; out CallProcessLoop: boolean);
295 begin
296 CallProcessLoop:=false;
297 if not assigned(GController.MainProcess)
298 then begin
299 WriteLN('The process is not paused');
300 Exit;
301 end;
302
303 CallProcessLoop:=true;
304 end;
305
306 procedure HandleKill(AParams: String; out CallProcessLoop: boolean);
307 begin
308 CallProcessLoop:=false;
309 if not assigned(GController.MainProcess)
310 then begin
311 WriteLN('No process');
312 Exit;
313 end;
314
315 WriteLN('Terminating ...');
316 GController.Stop;
317 CallProcessLoop:=true;
318 end;
319
320 procedure HandleNextInst(AParams: String; out CallProcessLoop: boolean);
321 begin
322 CallProcessLoop:=false;
323 if not assigned(GController.MainProcess)
324 then begin
325 WriteLN('The process is not paused');
326 Exit;
327 end;
328 GController.StepOverInstr;
329 CallProcessLoop:=true;
330 end;
331
332 procedure HandleNext(AParams: String; out CallProcessLoop: boolean);
333 begin
334 CallProcessLoop:=false;
335 if not assigned(GController.MainProcess)
336 then begin
337 WriteLN('The process is not paused');
338 Exit;
339 end;
340 GController.Next;
341 CallProcessLoop:=true;
342 end;
343
344 procedure HandleStep(AParams: String; out CallProcessLoop: boolean);
345 begin
346 CallProcessLoop:=false;
347 if not assigned(GController.MainProcess)
348 then begin
349 WriteLN('The process is not paused');
350 Exit;
351 end;
352 GController.Step;
353 CallProcessLoop:=true;
354 end;
355
356 procedure HandleStepOut(AParams: String; out CallProcessLoop: boolean);
357 begin
358 CallProcessLoop:=false;
359 if not assigned(GController.MainProcess)
360 then begin
361 WriteLN('The process is not paused');
362 Exit;
363 end;
364 GController.StepOut;
365 CallProcessLoop:=true;
366 end;
367
368 procedure HandleStepInst(AParams: String; out CallProcessLoop: boolean);
369 begin
370 CallProcessLoop:=false;
371 if not assigned(GController.MainProcess)
372 then begin
373 WriteLN('The process is not paused');
374 Exit;
375 end;
376 GController.StepIntoInstr;
377 CallProcessLoop:=true;
378 end;
379
380 procedure HandleList(AParams: String; out CallProcessLoop: boolean);
381 begin
382 WriteLN('not implemented: list');
383 CallProcessLoop:=false;
384 end;
385
386 procedure HandleMemory(AParams: String; out CallProcessLoop: boolean);
387 // memory [-<size>] [<adress> <count>|<location> <count>]
388 var
389 P: array[1..3] of String;
390 Size, Count: Integer;
391 Address: QWord;
392 e, idx: Integer;
393 buf: array[0..256*16 - 1] of Byte;
394 BytesRead: Cardinal;
395 begin
396 CallProcessLoop:=false;
397 if GController.MainProcess = nil
398 then begin
399 WriteLN('No process');
400 Exit;
401 end;
402
403 P[1] := GetPart([], [' ', #9], AParams);
404 P[2] := GetPart([' ', #9], [' ', #9], AParams);
405 P[3] := GetPart([' ', #9], [' ', #9], AParams);
406
407 idx := 1;
408 Count := 1;
409 Size := 4;
410
411 Address := GController.CurrentProcess.GetInstructionPointerRegisterValue;
412
413 if P[idx] <> ''
414 then begin
415 if P[idx][1] = '-'
416 then begin
417 Size := -StrToIntDef(P[idx], -Size);
418 if not (Size in [1,2,4,8,16])
419 then begin
420 WriteLN('Illegal size: "', P[idx], '"');
421 Exit;
422 end;
423 Inc(idx);
424 end;
425 if P[idx] <> ''
426 then begin
427 if P[idx][1] = '%'
428 then begin
429
430 end
431 else begin
432 Val(P[idx], Address, e);
433 if e <> 0
434 then begin
435 WriteLN('Location "',P[idx],'": Symbol resolving not implemented');
436 Exit;
437 end;
438 end;
439 Inc(idx);
440 end;
441
442 if P[idx] <> ''
443 then begin
444 Count := StrToIntDef(P[idx], Count);
445 if Count > 256
446 then begin
447 WriteLN('Limiting count to 256');
448 Count := 256;
449 end;
450 Inc(idx);
451 end;
452 end;
453
454
455 BytesRead := Count * Size;
456 if not GController.MainProcess.ReadData(Address, BytesRead, buf)
457 then begin
458 WriteLN('Could not read memory at: ', FormatAddress(Address));
459 Exit;
460 end;
461
462 e := 0;
463 while BytesRead >= size do
464 begin
465 if e and ((32 div Size) - 1) = 0
466 then Write('[', FormatAddress(Address), '] ');
467
468 for idx := Size - 1 downto 0 do Write(IntToHex(buf[e * size + idx], 2));
469
470 Inc(e);
471 if e = 32 div Size
472 then WriteLn
473 else Write(' ');
474 Dec(BytesRead, Size);
475 Inc(Address, Size);
476 end;
477 if e <> 32 div Size
478 then WriteLn;
479 end;
480
481 procedure HandleWriteMemory(AParams: String; out CallProcessLoop: boolean);
482 // memory [<adress> <value>]
483 var
484 P: array[1..2] of String;
485 Size, Count: Integer;
486 Address: QWord;
487 Value: QWord;
488 e, idx: Integer;
489 buf: array[0..256*16 - 1] of Byte;
490 BytesRead: Cardinal;
491 begin
492 CallProcessLoop:=false;
493 if GController.MainProcess = nil
494 then begin
495 WriteLN('No process');
496 Exit;
497 end;
498
499 P[1] := GetPart([], [' ', #9], AParams);
500 P[2] := GetPart([' ', #9], [' ', #9], AParams);
501
502 idx := 1;
503 Count := 1;
504 Size := 4;
505
506 if P[idx] <> ''
507 then begin
508 if P[idx] <> ''
509 then begin
510 Val(P[idx], Address, e);
511 if e <> 0
512 then begin
513 WriteLN('Location "',P[idx],'": Symbol resolving not implemented');
514 Exit;
515 end;
516 Inc(idx);
517 end;
518
519 if P[idx] <> ''
520 then begin
521 Val(P[idx], Value, e);
522 if e <> 0
523 then begin
524 WriteLN('Value "',P[idx],'": Symbol resolving not implemented');
525 Exit;
526 end;
527 Inc(idx);
528 end;
529 end;
530
531
532 if not GController.MainProcess.WriteData(Address, 4, Value)
533 then begin
534 WriteLN('Could not write memory at: ', FormatAddress(Address));
535 Exit;
536 end;
537 end;
538
539
540 procedure HandleDisas(AParams: String; out CallProcessLoop: boolean);
541 begin
542 CallProcessLoop:=false;
543 WriteLN('not implemented: disassemble');
544 end;
545
546 procedure HandleEval(AParams: String; out CallProcessLoop: boolean);
547 var
548 AContext: TFpDbgInfoContext;
549 APasExpr: TFpPascalExpression;
550 APrettyPrinter: TFpPascalPrettyPrinter;
551 AVal: string;
552 s,p: string;
553 begin
554 if GController.MainProcess = nil
555 then begin
556 WriteLN('No Process');
557 Exit;
558 end;
559 CallProcessLoop:=false;
560
561 S := AParams;
562 P := GetPart([], [' ', #9], S);
563
564 AContext := GController.CurrentProcess.DbgInfo.FindContext(GController.CurrentProcess.GetInstructionPointerRegisterValue);
565 if AContext = nil then begin
566 Writeln('Invalid context');
567 exit;
568 end;
569
570 APasExpr := TFpPascalExpression.Create(P, AContext);
571 try
572 APasExpr.ResultValue; // trigger full validation
573 if not APasExpr.Valid then
574 begin
575 writeln(ErrorHandler.ErrorAsString(APasExpr.Error));
576 end
577 else
578 begin
579 APrettyPrinter := TFpPascalPrettyPrinter.Create(4);
580 try
581 APrettyPrinter.AddressSize:=AContext.SizeOfAddress;
582 if APrettyPrinter.PrintValue(AVal, APasExpr.ResultValue) then
583 begin
584 Writeln(AVal)
585 end
586 else
587 writeln('Invalid value');
588 finally
589 APrettyPrinter.Free;
590 end;
591 end;
592 finally
593 APasExpr.Free;
594 AContext.ReleaseReference;
595 end;
596 end;
597
598 procedure HandleQuit(AParams: String; out CallProcessLoop: boolean);
599 begin
600 WriteLN('Quitting ...');
601 if assigned(GController.MainProcess) then
602 begin
603 WriteLn('Killing application ...');
604 GController.Stop;
605 CallProcessLoop:=true;
606 end
607 else
608 CallProcessLoop := false;
609 CustomApplication.Terminate;
610 end;
611
612 //=================
613 // S H O W
614 //=================
615
616 procedure HandleShowHelp(AParams: String; out CallProcessLoop: boolean);
617 var
618 n: Integer;
619 cmd: TFPDCommand;
620 begin
621 CallProcessLoop:=false;
622 if AParams = ''
623 then begin
624 WriteLN('Available items:');
625 for n := 0 to MShowCommands.Count - 1 do
626 WriteLN(' ', MShowCommands[n].Command);
627 end
628 else begin
629 cmd := MShowCommands.FindCommand(AParams);
630 if cmd = nil
631 then WriteLN('Unknown item: "', AParams, '"')
632 else WriteLN(cmd.Help);
633 end;
634 end;
635
636 procedure HandleShowFile(AParams: String; out CallProcessLoop: boolean);
637 var
638 hFile, hMap: THandle;
639 FilePtr: Pointer;
640 begin
641 CallProcessLoop:=false;
642 if GController.ExecutableFilename = ''
643 then begin
644 WriteLN('No filename set');
645 Exit;
646 end;
647 {$ifdef windows}
648 hFile := CreateFile(PChar(GController.ExecutableFilename), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_FLAG_RANDOM_ACCESS, 0);
649 if hFile = INVALID_HANDLE_VALUE
650 then begin
651 WriteLN('File "', GController.ExecutableFilename, '" does not exist');
652 Exit;
653 end;
654
655 hMap := 0;
656 FilePtr := nil;
657 try
658 hMap := CreateFileMapping(hFile, nil, PAGE_READONLY{ or SEC_IMAGE}, 0, 0, nil);
659 if hMap = 0
660 then begin
661 WriteLN('Map error');
662 Exit;
663 end;
664
665 FilePtr := MapViewOfFile(hMap, FILE_MAP_READ, 0, 0, 0);
666 DumpPEImage(GetCurrentProcess, TDbgPtr(FilePtr));
667 finally
668 UnmapViewOfFile(FilePtr);
669 CloseHandle(hMap);
670 CloseHandle(hFile);
671 end;
672 {$endif windows}
673 end;
674
675 procedure HandleShowRegisters(AParams: String; out CallProcessLoop: boolean);
676 var
677 ARegisterValue: TDbgRegisterValue;
678 i: Integer;
679 begin
680 CallProcessLoop:=false;
681 if (GController.MainProcess = nil)
682 then begin
683 WriteLN('No process');
684 Exit;
685 end;
686
687 for i := 0 to GController.CurrentThread.RegisterValueList.Count-1 do
688 begin
689 ARegisterValue := GController.CurrentThread.RegisterValueList[i];
690 writeln(format('%7s: %s (%s)',[ARegisterValue.Name, FormatAddress(ARegisterValue.NumValue), ARegisterValue.StrValue]));
691 end;
692 end;
693
694 procedure HandleShowCallStack(AParams: String; out CallProcessLoop: boolean);
695 var
696 ACallStack: TDbgCallstackEntryList;
697 i: Integer;
698 begin
699 CallProcessLoop:=false;
700 if (GController.MainProcess = nil)
701 then begin
702 WriteLN('No process');
703 Exit;
704 end;
705
706 WriteLN('Callstack:');
707 ACallStack := GController.CurrentProcess.MainThread.CreateCallStackEntryList;
708 try
709 for i := 0 to ACallStack.Count-1 do
710 begin
711 write(' ', FormatAddress(ACallStack.Items[i].AnAddress),' ');
712 if ACallStack.Items[i].SourceFile<>'' then
713 writeln(ACallStack.Items[i].SourceFile,':',ACallStack.Items[i].Line)
714 else
715 writeln('unknown');
716 end;
717 finally
718 ACallStack.Free;
719 end;
720 end;
721
722 //=================
723 // S E T
724 //=================
725
726 procedure HandleSetHelp(AParams: String; out CallProcessLoop: boolean);
727 var
728 n: Integer;
729 cmd: TFPDCommand;
730 begin
731 CallProcessLoop:=false;
732 if AParams = ''
733 then begin
734 WriteLN('Usage: set param [<value>] When no value is given, the current value is shown.');
735 WriteLN('Available params:');
736 for n := 0 to MSetCommands.Count - 1 do
737 WriteLN(' ', MSetCommands[n].Command);
738 end
739 else begin
740 cmd := MSetCommands.FindCommand(AParams);
741 if cmd = nil
742 then WriteLN('Unknown param: "', AParams, '"')
743 else WriteLN(cmd.Help);
744 end;
745 end;
746
747 procedure HandleSetMode(AParams: String; out CallProcessLoop: boolean);
748 const
749 MODE: array[TFPDMode] of String = ('32', '64');
750 begin
751 CallProcessLoop:=false;
752 if AParams = ''
753 then WriteLN(' Mode: ', MODE[GMode])
754 else if AParams = '32'
755 then GMode := dm32
756 else if AParams = '64'
757 then GMode := dm64
758 else WriteLN('Unknown mode: "', AParams, '"')
759 end;
760
761 procedure HandleSetBoll(AParams: String; out CallProcessLoop: boolean);
762 const
763 MODE: array[Boolean] of String = ('off', 'on');
764 begin
765 CallProcessLoop:=false;
766 if AParams = ''
767 then WriteLN(' Break on library load: ', MODE[GBreakOnLibraryLoad])
768 else GBreakOnLibraryLoad := (Length(Aparams) > 1) and (AParams[2] in ['n', 'N'])
769 end;
770
771 procedure HandleSetImageInfo(AParams: String; out CallProcessLoop: boolean);
772 const
773 MODE: array[TFPDImageInfo] of String = ('none', 'name', 'detail');
774 begin
775 CallProcessLoop:=false;
776 if AParams = ''
777 then WriteLN(' Imageinfo: ', MODE[GImageInfo])
778 else begin
779 case StringCase(AParams, MODE, True, False) of
780 0: GImageInfo := iiNone;
781 1: GImageInfo := iiName;
782 2: GImageInfo := iiDetail;
783 else
784 WriteLN('Unknown type: "', AParams, '"')
785 end;
786 end;
787 end;
788
789
790 //=================
791 //=================
792 //=================
793
794 { TFPDCommand }
795
796 constructor TFPDCommand.Create(const AHandler: TFPDCommandHandler; const ACommand, AHelp: String);
797 begin
798 inherited Create;
799 FCommand := ACommand;
800 FHandler := AHandler;
801 FHelp := AHelp;
802 end;
803
804 { TFPDCommandList }
805
806 procedure TFPDCommandList.AddCommand(const ACommands: array of String; const AHandler: TFPDCommandHandler; const AHelp: String);
807 var
808 n: Integer;
809 begin
810 for n := Low(ACommands) to High(ACommands) do
811 FCommands.AddObject(ACommands[n], TFPDCommand.Create(AHandler, ACommands[n], AHelp));
812 end;
813
Countnull814 function TFPDCommandList.Count: Integer;
815 begin
816 Result := FCommands.Count;
817 end;
818
819 constructor TFPDCommandList.Create;
820 begin
821 inherited;
822 FCommands := TStringList.Create;
823 FCommands.Duplicates := dupError;
824 FCommands.Sorted := True;
825 end;
826
827 destructor TFPDCommandList.Destroy;
828 var
829 n: integer;
830 begin
831 for n := 0 to FCommands.Count - 1 do
832 FCommands.Objects[n].Free;
833 FreeAndNil(FCommands);
834 inherited;
835 end;
836
FindCommandnull837 function TFPDCommandList.FindCommand(const ACommand: String): TFPDCommand;
838 var
839 idx: Integer;
840 begin
841 idx := FCommands.IndexOf(ACommand);
842 if idx = -1
843 then Result := nil
844 else Result := TFPDCommand(FCommands.Objects[idx]);
845 end;
846
GetItemnull847 function TFPDCommandList.GetItem(const AIndex: Integer): TFPDCommand;
848 begin
849 Result := TFPDCommand(FCommands.Objects[AIndex]);
850 end;
851
852 procedure TFPDCommandList.HandleCommand(ACommand: String; out CallProcessLoop: boolean);
853 var
854 cmd: TFPDCommand;
855 S: String;
856 begin
857 S := GetPart([], [' ', #9], ACommand);
858 cmd := FindCommand(S);
859 if cmd = nil
860 then
861 begin
862 WriteLN('Unknown command: "', S, '"');
863 CallProcessLoop:=false;
864 end
865 else cmd.Handler(Trim(ACommand), CallProcessLoop);
866 end;
867
868 //=================
869 //=================
870 //=================
871
872 procedure Initialize;
873 begin
874 MCommands := TFPDCommandList.Create;
875
876 MCommands.AddCommand(['help', 'h', '?'], @HandleHelp, 'help [<command>]: Shows help on a command, or this help if no command given');
877 MCommands.AddCommand(['quit', 'q'], @HandleQuit, 'quit: Quits the debugger');
878 MCommands.AddCommand(['file', 'f'], @HandleFile, 'file <filename>: Loads the debuggee <filename>');
879 MCommands.AddCommand(['show', 's'], @HandleShow, 'show <info>: Enter show help for more info');
880 MCommands.AddCommand(['set'], @HandleSet, 'set param: Enter set help for more info');
881 MCommands.AddCommand(['run', 'r'], @HandleRun, 'run [params]: Starts the loaded debuggee');
882 MCommands.AddCommand(['break', 'b'], @HandleBreak, 'break [-d] <adress>|<filename:line>: Set a breakpoint at <adress> or <filename:line>. -d removes');
883 MCommands.AddCommand(['continue', 'cont', 'c'], @HandleContinue, 'continue: Continues execution');
884 MCommands.AddCommand(['kill', 'k'], @HandleKill, 'kill: Stops execution of the debuggee');
885 MCommands.AddCommand(['step-inst', 'si'], @HandleStepInst, 'step-inst: Steps-into one instruction');
886 MCommands.AddCommand(['next-inst', 'ni'], @HandleNextInst, 'next-inst: Steps-over one instruction');
887 MCommands.AddCommand(['next', 'n'], @HandleNext, 'next: Steps one line');
888 MCommands.AddCommand(['step', 'st'], @HandleStep, 'step: Steps one line into procedure');
889 MCommands.AddCommand(['step-out', 'so'], @HandleStepOut, 'step-out: Steps out of current procedure');
890 MCommands.AddCommand(['list', 'l'], @HandleList, 'list [<adress>|<location>]: Lists the source for <adress> or <location>');
891 MCommands.AddCommand(['memory', 'mem', 'm'], @HandleMemory, 'memory [-<size>] [<adress> <count>|<location> <count>]: Dump <count> (default: 1) from memory <adress> or <location> (default: current) of <size> (default: 4) bytes, where size is 1,2,4,8 or 16.');
892 MCommands.AddCommand(['writememory', 'w'], @HandleWriteMemory, 'writememory [<adress> <value>]: Write <value> (with a length of 4 bytes) into memory at address <adress>.');
893 MCommands.AddCommand(['disassemble', 'dis', 'd'], @HandleDisas, 'disassemble [<adress>|<location>] [<count>]: Disassemble <count> instructions from <adress> or <location> or current IP if none given');
894 MCommands.AddCommand(['evaluate', 'eval', 'e'], @HandleEval, 'evaluate <symbol>: Evaluate <symbol>');
895
896
897 MShowCommands := TFPDCommandList.Create;
898
899 MShowCommands.AddCommand(['help', 'h', '?'], @HandleShowHelp, 'show help [<info>]: Shows help for info or this help if none given');
900 MShowCommands.AddCommand(['file', 'f'], @HandleShowFile, 'show file: Shows the info for the current file');
901 MShowCommands.AddCommand(['callstack', 'c'], @HandleShowCallStack, 'show callstack: Shows the callstack');
902 MShowCommands.AddCommand(['registers', 'r'], @HandleShowRegisters, 'show registers: Show the values of all registers');
903
904 MSetCommands := TFPDCommandList.Create;
905
906 MSetCommands.AddCommand(['help', 'h', '?'], @HandleSetHelp, 'set help [<param>]: Shows help for param or this help if none given');
907 MSetCommands.AddCommand(['mode', 'm'], @HandleSetMode, 'set mode 32|64: Set the mode for retrieving process info');
908 MSetCommands.AddCommand(['break_on_library_load', 'boll'], @HandleSetBOLL, 'set break_on_library_load on|off: Pause running when a library is loaded (default off)');
909 MSetCommands.AddCommand(['imageinfo', 'ii'], @HandleSetImageInfo, 'set imageinfo none|name|detail: When a library is loaded, show nothing, only its name or all details (default none)');
910 end;
911
912 procedure Finalize;
913 begin
914 FreeAndNil(MCommands);
915 FreeAndNil(MSetCommands);
916 FreeAndNil(MShowCommands);
917 end;
918
919 initialization
920 Initialize;
921
922 finalization
923 Finalize;
924
925 end.
926