/debugger/fpdebug/test/asmtestunit.pas

http://github.com/graemeg/lazarus · Pascal · 81 lines · 60 code · 14 blank · 7 comment · 7 complexity · 85ba825f18477c7d94b9eb3edf270144 MD5 · raw file

  1. unit AsmTestUnit;
  2. {$mode objfpc}{$H+}
  3. interface
  4. uses
  5. Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, windisas,
  6. ExtCtrls, LCLProc, Math;
  7. type
  8. { TForm1 }
  9. TForm1 = class(TForm)
  10. chk64Bit: TCheckBox;
  11. Timer1: TTimer;
  12. txtOutput: TEdit;
  13. Label1: TLabel;
  14. Label2: TLabel;
  15. txtCode: TMemo;
  16. procedure Timer1Timer(Sender: TObject);
  17. private
  18. { private declarations }
  19. public
  20. { public declarations }
  21. end;
  22. var
  23. Form1: TForm1;
  24. implementation
  25. { TForm1 }
  26. procedure TForm1.Timer1Timer(Sender: TObject);
  27. var
  28. idx, n: Integer;
  29. Line, S: String;
  30. Code: array[0..28] of Byte;
  31. CodeIdx, B: Byte;
  32. Value: Int64;
  33. e: Integer;
  34. p: Pointer;
  35. begin
  36. n := txtCode.SelStart;
  37. if n < 0 then Exit;
  38. S := Copy(txtCode.Text, 1, n);
  39. idx := 0;
  40. for n := 1 to Length(S) do
  41. begin
  42. if S[n] = #10 then Inc(idx);
  43. end;
  44. Line := txtCode.Lines[idx];
  45. CodeIdx := 0;
  46. while (Line <> '') and (CodeIdx < 20) do
  47. begin
  48. S := GetPart([], [' ', #9], Line);
  49. Delete(Line, 1, 1); // strip end ' ' or #9
  50. if S = '' then Continue;
  51. B := Min(16, Length(S));
  52. Val('$' + S, Value, e);
  53. if e <> 0 then Continue;
  54. Move(Value, Code[CodeIdx], B div 2);
  55. Inc(CodeIdx, B div 2);
  56. end;
  57. if CodeIdx > 0
  58. then begin
  59. p := @Code;
  60. Disassemble(p, chk64Bit.Checked, S, Line);
  61. txtOutput.Text := S + ' '+ Line;
  62. end
  63. // else txtOutput.Text :='';
  64. end;
  65. initialization
  66. {$I asmtestunit.lrs}
  67. end.