/debugger/fpdebug/fpd/fpdcommand.pas

  1{ $Id$ }
  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$)
 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
 31 *                                                                         *
 32 ***************************************************************************
 33}
 34unit FPDCommand;
 35{$mode objfpc}{$H+}
 36interface
 37
 38uses
 39  SysUtils, Classes, Windows, DbgWinExtra, DbgClasses, LCLProc;
 40
 41procedure HandleCommand(ACommand: String);
 42
 43implementation
 44
 45uses
 46  FPDGlobal, FPDLoop, FPDPEImage;
 47
 48type
 49  TFPDCommandHandler = procedure(AParams: String);
 50
 51  TFPDCommand = class
 52  private
 53    FCommand: String;
 54    FHandler: TFPDCommandHandler;
 55    FHelp: String;
 56  public
 57    constructor Create(const AHandler: TFPDCommandHandler; const ACommand, AHelp: String);
 58    property Command: String read FCommand;
 59    property Handler: TFPDCommandHandler read FHandler;
 60    property Help: String read FHelp;
 61  end;
 62
 63  TFPDCommandList = class
 64  private
 65    FCommands: TStringList;
 66    function GetItem(const AIndex: Integer): TFPDCommand;
 67  public
 68    procedure AddCommand(const ACommands: array of String; const AHandler: TFPDCommandHandler; const AHelp: String);
 69    function Count: Integer;
 70    constructor Create;
 71    destructor Destroy; override;
 72    function FindCommand(const ACommand: String): TFPDCommand;
 73    procedure HandleCommand(ACommand: String);
 74    property Items[const AIndex: Integer]: TFPDCommand read GetItem; default;
 75  end;
 76
 77
 78var
 79  MCommands: TFPDCommandList;
 80  MShowCommands: TFPDCommandList;
 81  MSetCommands: TFPDCommandList;
 82
 83procedure HandleCommand(ACommand: String);
 84begin
 85  MCommands.HandleCommand(ACommand);
 86end;
 87
 88
 89procedure HandleHelp(AParams: String);
 90var
 91  n: Integer;
 92  cmd: TFPDCommand;
 93begin
 94  if AParams = ''
 95  then begin
 96    WriteLN('Available commands:');
 97    for n := 0 to MCommands.Count - 1 do
 98      WriteLN(' ', MCommands[n].Command);
 99    end
100  else begin
101    cmd := MCommands.FindCommand(AParams);
102    if cmd = nil
103    then WriteLN('Unknown command: "', AParams, '"')
104    else WriteLN(cmd.Help);
105  end;
106end;
107
108procedure HandleFile(AParams: String);
109begin
110  if AParams <> ''
111  then GFileName := AParams;
112
113  // TODO separate exec from args
114end;
115
116procedure HandleShow(AParams: String);
117var
118  cmd: TFPDCommand;
119  S: String;
120begin
121  S := GetPart([], [' ', #9], AParams);
122  if S = '' then S := 'help';
123  cmd := MShowCommands.FindCommand(S);
124  if cmd = nil
125  then WriteLN('Unknown item: "', S, '"')
126  else cmd.Handler(Trim(AParams));
127end;
128
129procedure HandleSet(AParams: String);
130var
131  cmd: TFPDCommand;
132  S: String;
133begin
134  S := GetPart([], [' ', #9], AParams);
135  if S = '' then S := 'help';
136  cmd := MSetCommands.FindCommand(S);
137  if cmd = nil
138  then WriteLN('Unknown param: "', S, '"')
139  else cmd.Handler(Trim(AParams));
140end;
141
142
143procedure HandleRun(AParams: String);
144var
145  StartupInfo: TStartupInfo;
146  ProcessInformation: TProcessInformation;
147  ThreadAttributes: TSecurityAttributes;
148begin
149  if GState <> dsStop
150  then begin
151    WriteLN('The debuggee is already running');
152    Exit;
153  end;
154
155  if GFileName = ''
156  then begin
157    WriteLN('No filename set');
158    Exit;
159  end;
160
161  ZeroMemory(@StartUpInfo, SizeOf(StartupInfo));
162  StartUpInfo.cb := SizeOf(StartupInfo);
163  StartUpInfo.dwFlags := {STARTF_USESTDHANDLES or} STARTF_USESHOWWINDOW;
164  StartUpInfo.wShowWindow := SW_SHOWNORMAL or SW_SHOW;
165
166//  ZeroMemory(@ThreadAttributes, SizeOf(ThreadAttributes));
167//  ThreadAttributes.nLength := SizeOf(ThreadAttributes);
168//  ThreadAttributes.lpSecurityDescriptor
169
170  ZeroMemory(@ProcessInformation, SizeOf(ProcessInformation));
171  if not CreateProcess(nil, PChar(GFileName), nil, nil, True, DETACHED_PROCESS or DEBUG_PROCESS or CREATE_NEW_PROCESS_GROUP, nil, nil, StartUpInfo, ProcessInformation)
172  then begin
173    WriteLN('Create process failed: ', GetLastErrorText);
174    Exit;
175  end;
176
177  WriteLN('Got PID:', ProcessInformation.dwProcessId, ', TID: ',ProcessInformation.dwThreadId);
178
179  GState := dsRun;
180  DebugLoop;
181end;
182
183procedure HandleBreak(AParams: String);
184var
185  S, P: String;
186  Remove: Boolean;
187  Address: TDbgPtr;
188  e: Integer;
189  Line: Cardinal;
190  bp: TDbgBreakpoint;
191begin
192  if GCurrentProcess = nil
193  then begin
194    WriteLN('No Process');
195    Exit;
196  end;
197
198  S := AParams;
199  P := GetPart([], [' ', #9], S);
200  Remove := P = '-d';
201  if not Remove
202  then S := P;
203  
204  if S = ''
205  then begin
206    // current addr
207    P := '';
208    {$ifdef cpui386}
209    Address := GCurrentContext^.Eip;
210    {$else}
211    Address := GCurrentContext^.Rip;
212    {$endif}
213  end
214  else begin
215    P := GetPart([], [':'], S);
216  end;
217  
218  if S = ''
219  then begin
220    if P <> ''
221    then begin
222      // address given
223      Val(P, Address, e);
224      if e <> 0
225      then begin
226        WriteLN('Illegal address: ', P);
227        Exit;
228      end;
229    end;
230    if Remove
231    then begin
232      if GCurrentProcess.RemoveBreak(Address)
233      then WriteLn('breakpoint removed')
234      else WriteLn('remove breakpoint failed');
235    end
236    else begin
237      if GCurrentProcess.AddBreak(Address) <> nil
238      then WriteLn('breakpoint added')
239      else WriteLn('add breakpoint failed');
240    end;
241  end
242  else begin
243    S := GetPart([':'], [], S);
244    Val(S, Line, e);
245    if e <> 0
246    then begin
247      WriteLN('Illegal line: ', S);
248      Exit;
249    end;
250    if Remove
251    then begin
252      if TDbgInstance(GCurrentProcess).RemoveBreak(P, Line)
253      then WriteLn('breakpoint removed')
254      else WriteLn('remove breakpoint failed');
255      Exit;
256    end;
257
258    bp := TDbgInstance(GCurrentProcess).AddBreak(P, Line);
259    if bp = nil
260    then begin
261      WriteLn('add breakpoint failed');
262      Exit;
263    end;
264    
265    WriteLn('breakpoint added at: ', FormatAddress(bp.Location));
266  end;
267end;
268
269procedure HandleContinue(AParams: String);
270begin
271  if GState <> dsPause
272  then begin
273    WriteLN('The process is not paused');
274    Exit;
275  end;
276  DebugLoop;
277end;
278
279procedure HandleKill(AParams: String);
280begin
281  if not (GState in [dsRun, dsPause]) or (GMainProcess = nil)
282  then begin
283    WriteLN('No process');
284    Exit;
285  end;
286
287  WriteLN('Terminating...');
288  TerminateProcess(GMainProcess.Handle, 0);
289  if GState = dsPause
290  then DebugLoop; // continue runnig so we can terminate
291end;
292
293procedure HandleNext(AParams: String);
294begin
295  if GState <> dsPause
296  then begin
297    WriteLN('The process is not paused');
298    Exit;
299  end;
300  if GCurrentThread = nil
301  then begin
302    WriteLN('No current thread');
303    Exit;
304  end;
305  GCurrentThread.SingleStep;
306  DebugLoop;
307end;
308
309procedure HandleList(AParams: String);
310begin
311  WriteLN('not implemented: list');
312end;
313
314procedure HandleMemory(AParams: String);
315// memory [-<size>] [<adress> <count>|<location> <count>]
316var
317  P: array[1..3] of String;
318  Size, Count: Integer;
319  Address: QWord;
320  e, idx: Integer;
321  buf: array[0..256*16 - 1] of Byte;
322  BytesRead: Cardinal;
323begin
324  if GMainProcess = nil
325  then begin
326    WriteLN('No process');
327    Exit;
328  end;
329
330  P[1] := GetPart([], [' ', #9], AParams);
331  P[2] := GetPart([' ', #9], [' ', #9], AParams);
332  P[3] := GetPart([' ', #9], [' ', #9], AParams);
333
334  idx := 1;
335  Count := 1;
336  Size := 4;
337  
338  {$ifdef cpui386}
339  Address := GCurrentContext^.Eip;
340  {$else}
341  Address := GCurrentContext^.Rip;
342  {$endif}
343
344  if P[idx] <> ''
345  then begin
346    if P[idx][1] = '-'
347    then begin
348      Size := -StrToIntDef(P[idx], -Size);
349      if not (Size in [1,2,4,8,16])
350      then begin
351        WriteLN('Illegal size: "', P[idx], '"');
352        Exit;
353      end;
354      Inc(idx);
355    end;
356    if P[idx] <> ''
357    then begin
358      if P[idx][1] = '%'
359      then begin
360
361      end
362      else begin
363        Val(P[idx], Address, e);
364        if e <> 0
365        then begin
366          WriteLN('Location "',P[idx],'": Symbol resolving not implemented');
367          Exit;
368        end;
369      end;
370      Inc(idx);
371    end;
372
373    if P[idx] <> ''
374    then begin
375      Count := StrToIntDef(P[idx], Count);
376      if Count > 256
377      then begin
378        WriteLN('Limiting count to 256');
379        Count := 256;
380      end;
381      Inc(idx);
382    end;
383  end;
384
385
386  BytesRead := Count * Size;
387  if not GMainProcess.ReadData(Address, BytesRead, buf)
388  then begin
389    WriteLN('Could not read memory at: ', FormatAddress(Address));
390    Exit;
391  end;
392
393  e := 0;
394  while BytesRead >= size do
395  begin
396    if e and ((32 div Size) - 1) = 0
397    then Write('[', FormatAddress(Address), '] ');
398
399    for idx := Size - 1 downto 0 do Write(IntToHex(buf[e * size + idx], 2));
400
401    Inc(e);
402    if e = 32 div Size
403    then WriteLn
404    else Write(' ');
405    Dec(BytesRead, Size);
406    Inc(Address, Size);
407  end;
408  if e <> 32 div Size
409  then WriteLn;
410end;
411
412procedure HandleDisas(AParams: String);
413begin
414  WriteLN('not implemented: disassemble');
415end;
416
417procedure HandleEval(AParams: String);
418begin
419  WriteLN('not implemented: evaluate');
420end;
421
422procedure HandleQuit(AParams: String);
423begin
424  WriteLN('Quitting...');
425  GState := dsQuit;
426end;
427
428//=================
429// S H O W
430//=================
431
432procedure HandleShowHelp(AParams: String);
433var
434  n: Integer;
435  cmd: TFPDCommand;
436begin
437  if AParams = ''
438  then begin
439    WriteLN('Available items:');
440    for n := 0 to MShowCommands.Count - 1 do
441      WriteLN(' ', MShowCommands[n].Command);
442    end
443  else begin
444    cmd := MShowCommands.FindCommand(AParams);
445    if cmd = nil
446    then WriteLN('Unknown item: "', AParams, '"')
447    else WriteLN(cmd.Help);
448  end;
449end;
450
451procedure HandleShowFile(AParams: String);
452var
453  hFile, hMap: THandle;
454  FilePtr: Pointer;
455begin
456  if GFileName = ''
457  then begin
458    WriteLN('No filename set');
459    Exit;
460  end;
461
462  hFile := CreateFile(PChar(GFileName), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_FLAG_RANDOM_ACCESS, 0);
463  if hFile = INVALID_HANDLE_VALUE
464  then begin
465    WriteLN('File "', GFileName, '" does not exist');
466    Exit;
467  end;
468
469  hMap := 0;
470  FilePtr := nil;
471  try
472    hMap := CreateFileMapping(hFile, nil, PAGE_READONLY{ or SEC_IMAGE}, 0, 0, nil);
473    if hMap = 0
474    then begin
475      WriteLN('Map error');
476      Exit;
477    end;
478
479    FilePtr := MapViewOfFile(hMap, FILE_MAP_READ, 0, 0, 0);
480    DumpPEImage(GetCurrentProcess, TDbgPtr(FilePtr));
481  finally
482    UnmapViewOfFile(FilePtr);
483    CloseHandle(hMap);
484    CloseHandle(hFile);
485  end;
486end;
487
488procedure HandleShowCallStack(AParams: String);
489var
490  Address, Frame, LastFrame: QWord;
491  Size, Count: integer;
492begin
493  if (GMainProcess = nil) or (GCurrentProcess = nil)
494  then begin
495    WriteLN('No process');
496    Exit;
497  end;
498  if GState <> dsPause
499  then begin
500    WriteLN('Process not paused');
501    Exit;
502  end;
503
504  {$ifdef cpui386}
505  Address := GCurrentContext^.Eip;
506  Frame := GCurrentContext^.Ebp;
507  Size := 4;
508  {$else}
509  Address := GCurrentContext^.Rip;
510  Frame := GCurrentContext^.Rdi;
511  Size := 8;
512  {$endif}
513
514  WriteLN('Callstack:');
515  WriteLn(' ', FormatAddress(Address));
516  LastFrame := 0;
517  Count := 25;
518  while (Frame <> 0) and (Frame > LastFrame) do
519  begin
520    if not GCurrentProcess.ReadData(Frame + Size, Size, Address) or (Address = 0) then Break;
521    WriteLn(' ', FormatAddress(Address));
522    Dec(count);
523    if Count <= 0 then Exit;
524    if not GCurrentProcess.ReadData(Frame, Size, Frame) then Break;
525  end;
526end;
527
528//=================
529// S E T
530//=================
531
532procedure HandleSetHelp(AParams: String);
533var
534  n: Integer;
535  cmd: TFPDCommand;
536begin
537  if AParams = ''
538  then begin
539    WriteLN('Usage: set param [<value>] When no value is given, the current value is shown.');
540    WriteLN('Available params:');
541    for n := 0 to MSetCommands.Count - 1 do
542      WriteLN(' ', MSetCommands[n].Command);
543    end
544  else begin
545    cmd := MSetCommands.FindCommand(AParams);
546    if cmd = nil
547    then WriteLN('Unknown param: "', AParams, '"')
548    else WriteLN(cmd.Help);
549  end;
550end;
551
552procedure HandleSetMode(AParams: String);
553const
554  MODE: array[TFPDMode] of String = ('32', '64');
555begin
556  if AParams = ''
557  then WriteLN(' Mode: ', MODE[GMode])
558  else if AParams = '32'
559  then GMode := dm32
560  else if AParams = '64'
561  then GMode := dm64
562  else WriteLN('Unknown mode: "', AParams, '"')
563end;
564
565procedure HandleSetBoll(AParams: String);
566const
567  MODE: array[Boolean] of String = ('off', 'on');
568begin
569  if AParams = ''
570  then WriteLN(' Break on library load: ', MODE[GBreakOnLibraryLoad])
571  else GBreakOnLibraryLoad := (Length(Aparams) > 1) and (AParams[2] in ['n', 'N'])
572end;
573
574procedure HandleSetImageInfo(AParams: String);
575const
576  MODE: array[TFPDImageInfo] of String = ('none', 'name', 'detail');
577begin
578  if AParams = ''
579  then WriteLN(' Imageinfo: ', MODE[GImageInfo])
580  else begin
581    case StringCase(AParams, MODE, True, False) of
582      0: GImageInfo := iiNone;
583      1: GImageInfo := iiName;
584      2: GImageInfo := iiDetail;
585    else
586      WriteLN('Unknown type: "', AParams, '"')
587    end;
588  end;
589end;
590
591
592//=================
593//=================
594//=================
595
596{ TFPDCommand }
597
598constructor TFPDCommand.Create(const AHandler: TFPDCommandHandler; const ACommand, AHelp: String);
599begin
600  inherited Create;
601  FCommand := ACommand;
602  FHandler := AHandler;
603  FHelp := AHelp;
604end;
605
606{ TFPDCommandList }
607
608procedure TFPDCommandList.AddCommand(const ACommands: array of String; const AHandler: TFPDCommandHandler; const AHelp: String);
609var
610  n: Integer;
611begin
612  for n := Low(ACommands) to High(ACommands) do
613    FCommands.AddObject(ACommands[n], TFPDCommand.Create(AHandler, ACommands[n], AHelp));
614end;
615
616function TFPDCommandList.Count: Integer;
617begin
618  Result := FCommands.Count;
619end;
620
621constructor TFPDCommandList.Create;
622begin
623  inherited;
624  FCommands := TStringList.Create;
625  FCommands.Duplicates := dupError;
626  FCommands.Sorted := True;
627end;
628
629destructor TFPDCommandList.Destroy;
630var
631  n: integer;
632begin
633  for n := 0 to FCommands.Count - 1 do
634    FCommands.Objects[n].Free;
635  FreeAndNil(FCommands);
636  inherited;
637end;
638
639function TFPDCommandList.FindCommand(const ACommand: String): TFPDCommand;
640var
641  idx: Integer;
642begin
643  idx := FCommands.IndexOf(ACommand);
644  if idx = -1
645  then Result := nil
646  else Result := TFPDCommand(FCommands.Objects[idx]);
647end;
648
649function TFPDCommandList.GetItem(const AIndex: Integer): TFPDCommand;
650begin
651  Result := TFPDCommand(FCommands.Objects[AIndex]);
652end;
653
654procedure TFPDCommandList.HandleCommand(ACommand: String);
655var
656  cmd: TFPDCommand;
657  S: String;
658begin
659  S := GetPart([], [' ', #9], ACommand);
660  cmd := FindCommand(S);
661  if cmd = nil
662  then WriteLN('Unknown command: "', S, '"')
663  else cmd.Handler(Trim(ACommand));
664end;
665
666//=================
667//=================
668//=================
669
670procedure Initialize;
671begin
672  MCommands := TFPDCommandList.Create;
673
674  MCommands.AddCommand(['help', 'h', '?'], @HandleHelp, 'help [<command>]: Shows help on a command, or this help if no command given');
675  MCommands.AddCommand(['quit', 'q'], @HandleQuit,  'quit: Quits the debugger');
676  MCommands.AddCommand(['file', 'f'], @HandleFile, 'file <filename>: Loads the debuggee <filename>');
677  MCommands.AddCommand(['show', 's'], @HandleShow, 'show <info>: Enter show help for more info');
678  MCommands.AddCommand(['set'], @HandleSet,  'set param: Enter set help for more info');
679  MCommands.AddCommand(['run', 'r'], @HandleRun,  'run: Starts the loaded debuggee');
680  MCommands.AddCommand(['break', 'b'], @HandleBreak,  'break [-d] <adress>|<filename:line>: Set a breakpoint at <adress> or <filename:line>. -d removes');
681  MCommands.AddCommand(['continue', 'cont', 'c'], @HandleContinue,  'continue: Continues execution');
682  MCommands.AddCommand(['kill', 'k'], @HandleKill,  'kill: Stops execution of the debuggee');
683  MCommands.AddCommand(['next', 'n'], @HandleNext,  'next: Steps one instruction');
684  MCommands.AddCommand(['list', 'l'], @HandleList,  'list [<adress>|<location>]: Lists the source for <adress> or <location>');
685  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.');
686  MCommands.AddCommand(['disassemble', 'dis', 'd'], @HandleDisas,  'disassemble [<adress>|<location>] [<count>]: Disassemble <count> instructions from <adress> or <location> or current IP if none given');
687  MCommands.AddCommand(['evaluate', 'eval', 'e'], @HandleEval,  'evaluate <symbol>: Evaluate <symbol>');
688
689
690  MShowCommands := TFPDCommandList.Create;
691
692  MShowCommands.AddCommand(['help', 'h', '?'], @HandleShowHelp, 'show help [<info>]: Shows help for info or this help if none given');
693  MShowCommands.AddCommand(['file', 'f'], @HandleShowFile, 'show file: Shows the info for the current file');
694  MShowCommands.AddCommand(['callstack', 'c'], @HandleShowCallStack,  'show callstack: Shows the callstack');
695
696  MSetCommands := TFPDCommandList.Create;
697
698  MSetCommands.AddCommand(['help', 'h', '?'], @HandleSetHelp, 'set help [<param>]: Shows help for param or this help if none given');
699  MSetCommands.AddCommand(['mode', 'm'], @HandleSetMode, 'set mode 32|64: Set the mode for retrieving process info');
700  MSetCommands.AddCommand(['break_on_library_load', 'boll'], @HandleSetBOLL, 'set break_on_library_load on|off: Pause running when a library is loaded (default off)');
701  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)');
702end;
703
704procedure Finalize;
705begin
706  FreeAndNil(MCommands);
707  FreeAndNil(MSetCommands);
708  FreeAndNil(MShowCommands);
709end;
710
711initialization
712  Initialize;
713
714finalization
715  Finalize;
716
717end.