/debugger/fpdebug/fpd/fpdcommand.pas

http://github.com/graemeg/lazarus · Pascal · 717 lines · 565 code · 88 blank · 64 comment · 91 complexity · fa21e78188c75a6e53d93058cd2c7717 MD5 · raw file

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