paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 02:59:33 +02:00
Code Issues Packages Projects Releases Wiki Activity

* PushExceptObject and dump_stack: use get_caller_stackinfo instead of get_caller_addr and get_caller_frame.

Browse Source 
git-svn-id: trunk@27094 -
This commit is contained in:
sergei 2014-03-11 12:51:46 +00:00
parent abc1468a7a
commit 2f05e8b389
2 changed files with 15 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
rtl/inc/except.inc
View File

@ -113,10 +113,8 @@ var
framecount : longint; framecount : longint;
frames : PCodePointer; frames : PCodePointer;
prev_frame, prev_frame,
curr_frame, curr_frame : Pointer;
caller_frame : Pointer; curr_addr : CodePointer;
curr_addr,
caller_addr : CodePointer;
begin begin
{$ifdef excdebug} {$ifdef excdebug}
writeln ('In PushExceptObject'); writeln ('In PushExceptObject');
@ -141,21 +139,18 @@ begin
while (framecount<RaiseMaxFrameCount) and (curr_frame > prev_frame) and while (framecount<RaiseMaxFrameCount) and (curr_frame > prev_frame) and
(curr_frame<(StackBottom + StackLength)) do (curr_frame<(StackBottom + StackLength)) do
Begin Begin
caller_addr := get_caller_addr(curr_frame, curr_addr); prev_frame:=curr_frame;
caller_frame := get_caller_frame(curr_frame, curr_addr); get_caller_stackinfo(curr_frame,curr_addr);
if (caller_addr=nil) or if (curr_addr=nil) or
(caller_frame=nil) then (curr_frame=nil) then
break; break;
if (framecount>=framebufsize) then if (framecount>=framebufsize) then
begin begin
inc(framebufsize,16); inc(framebufsize,16);
reallocmem(frames,framebufsize*sizeof(codepointer)); reallocmem(frames,framebufsize*sizeof(codepointer));
end; end;
frames[framecount]:=caller_addr; frames[framecount]:=curr_addr;
inc(framecount); inc(framecount);
prev_frame:=curr_frame;
curr_addr:=caller_addr;
curr_frame:=caller_frame;
End; End;
NewObj^.framecount:=framecount; NewObj^.framecount:=framecount;
NewObj^.frames:=frames; NewObj^.frames:=frames;

23
rtl/inc/system.inc
View File

@ -1139,36 +1139,29 @@ Procedure dump_stack(var f : text;fp : Pointer; addr : CodePointer);
var var
i : Longint; i : Longint;
prevfp : Pointer; prevfp : Pointer;
prevaddr : CodePointer;
is_dev : boolean; is_dev : boolean;
caller_frame : Pointer;
caller_addr : CodePointer;
Begin Begin
{$ifdef FPC_HAS_FEATURE_EXCEPTIONS} {$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
try try
{$endif FPC_HAS_FEATURE_EXCEPTIONS} {$endif FPC_HAS_FEATURE_EXCEPTIONS}
prevfp:=fp-1; { Frame of this procedure acts as StackBottom, fp values below that are invalid. }
prevaddr:=nil; prevfp:=get_frame;
i:=0; i:=0;
is_dev:=do_isdevice(textrec(f).Handle); is_dev:=do_isdevice(textrec(f).Handle);
{ sanity checks, new frame pointer must be always greater than the old one, further { sanity checks, new frame pointer must be always greater than the old one, further
it must point into the stack area, else something went wrong } it must point into the stack area, else something went wrong }
while (fp>prevfp) and (fp<StackTop) and (fp>StackBottom) Do while (fp>prevfp) and (fp<StackTop) do
Begin Begin
caller_addr := get_caller_addr(fp,addr); prevfp:=fp;
caller_frame := get_caller_frame(fp,addr); get_caller_stackinfo(fp,addr);
if (caller_addr=nil) then if (addr=nil) then
break; break;
Writeln(f,BackTraceStrFunc(caller_addr)); Writeln(f,BackTraceStrFunc(addr));
if (caller_frame=nil) then if (fp=nil) then
break; break;
Inc(i); Inc(i);
If ((i>max_frame_dump) and is_dev) or (i>256) Then If ((i>max_frame_dump) and is_dev) or (i>256) Then
break; break;
prevfp:=fp;
prevaddr:=addr;
fp:=caller_frame;
addr:=caller_addr;
End; End;
{$ifdef FPC_HAS_FEATURE_EXCEPTIONS} {$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
except except