1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
|
{ %CPU=i386 }
{$ifdef FPC}
{$ASMMODE INTEL}
{$INLINE ON}
{$endif FPC}
program test;
type
tobj = object
x : word;
constructor init;
procedure test;virtual;
procedure testx;
end;
constructor tobj.init;
begin
x:=1;
end;
procedure tobj.testx;
begin
asm
mov ax,3
mov edx,SELF
mov word ptr[edx+x],ax
end;
end;
procedure tobj.test;
var
pattern: word;
dummyval : word;
function rotate: boolean; assembler; {$ifdef FPC}inline;{$endif FPC}
asm
mov al,0
rol word ptr [pattern],1
rcl al,1
end;
{ this does still not work because
it can only work as inline not as normal sub function
because dummyval and pattern are not reachable !! PM
function rotateb(dummy : byte) : boolean; assembler; inline;
asm
movzx byte ptr [dummy],ax
mov ax,word ptr [dummyval]
mov al,0
rol word ptr [pattern],1
rcl al,1
end; }
var
i : byte;
begin
pattern:= $a0a0;
for i:=1 to 16 do
begin
Write('obj pattern = ',
{$ifdef FPC}
hexstr(pattern,4),' ');
{$else}
pattern,' ');
{$endif}
if rotate then
Writeln('bit found')
else
Writeln('no bit found');
end;
end;
procedure changepattern;
var
pattern: word;
dummyval : word;
function rotate: boolean; assembler; {$ifdef FPC}inline;{$endif FPC}
asm
mov al,0
rol word ptr [pattern],1
rcl al,1
end;
{ this does still not work because
it can only work as inline not as normal sub function
because dummyval and pattern are not reachable !! PM
function rotateb(dummy : byte) : boolean; assembler; inline;
asm
movzx byte ptr [dummy],ax
mov ax,word ptr [dummyval]
mov al,0
rol word ptr [pattern],1
rcl al,1
end; }
var
i : byte;
begin
pattern:= $a0a0;
for i:=1 to 16 do
begin
Write('pattern = ',
{$ifdef FPC}
hexstr(pattern,4),' ');
{$else}
pattern,' ');
{$endif}
if rotate then
Writeln('bit found')
else
Writeln('no bit found');
end;
end;
var
t : tobj;
begin
changepattern;
t.init;
t.test;
t.testx;
if t.x<>3 then
begin
Writeln('Unable to access object fields in assembler');
Halt(1);
end;
end.
|
