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