PageRenderTime 19ms CodeModel.GetById 14ms app.highlight 2ms RepoModel.GetById 1ms app.codeStats 0ms

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