blob: b1d6be095ad6c96c2f3950e35ae1d3dd67435893 (
plain)
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
|
{ %CPU=i386 }
{ %OPT=-O2 }
{ Old file: tbs0002.pp }
{ tests for the endless bugs in the optimizer OK 0.9.2 }
unit tb0001;
interface
implementation
{$message starting hexstr}
function hexstr(val : longint;cnt : byte) : string;
const
hexval : string[16]=('0123456789ABCDEF');
var
s : string;
l2,i : integer;
l1 : longInt;
begin
s[0]:=char(cnt);
l1:=longint($f) shl (4*(cnt-1));
for i:=1 to cnt do
begin
l2:=(val and l1) shr (4*(cnt-i));
l1:=l1 shr 4;
s[i]:=hexval[l2+1];
end;
hexstr:=s;
end;
{$message starting dump_stack}
procedure dump_stack(bp : longint);
{$message starting get_next_frame}
function get_next_frame(bp : longint) : longint;
begin
asm
movl bp,%eax
movl (%eax),%eax
movl %eax,__RESULT
end ['EAX'];
end;
procedure dump_frame(addr : longint);
begin
{ to be used by symify }
writeln(' 0x',HexStr(addr,8));
end;
{$message starting get_addr}
function get_addr(BP : longint) : longint;
begin
asm
movl BP,%eax
movl 4(%eax),%eax
movl %eax,__RESULT
end ['EAX'];
end;
{$message starting main}
var
i,prevbp : longint;
begin
prevbp:=bp-1;
i:=0;
while bp > prevbp do
begin
dump_frame(get_addr(bp));
i:=i+1;
if i>max_frame_dump then exit;
prevbp:=bp;
bp:=get_next_frame(bp);
end;
end;
end.
|