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

* renamed parameter bp (x86 ism) into fp for dump_stack

Browse Source 
* more sanity checks if fp really points into the stack

git-svn-id: trunk@24975 -
This commit is contained in:
florian 2013-06-25 19:46:08 +00:00
parent f50e25afa0
commit 844806cb19
2 changed files with 11 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
rtl/inc/system.inc
View File

@ -1135,10 +1135,10 @@ begin
end;
Procedure dump_stack(var f : text;bp,addr : Pointer);
Procedure dump_stack(var f : text;fp,addr : Pointer);
var
i : Longint;
prevbp : Pointer;
prevfp : Pointer;
prevaddr : pointer;
is_dev : boolean;
caller_frame,
@ -1147,14 +1147,16 @@ Begin
{$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
try
{$endif FPC_HAS_FEATURE_EXCEPTIONS}
prevbp:=bp-1;
prevfp:=fp-1;
prevaddr:=nil;
i:=0;
is_dev:=do_isdevice(textrec(f).Handle);
while bp > prevbp Do
{ 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 }
while (fp>prevfp) and (fp<StackTop) and (fp>StackBottom) Do
Begin
caller_addr := get_caller_addr(bp,addr);
caller_frame := get_caller_frame(bp,addr);
caller_addr := get_caller_addr(fp,addr);
caller_frame := get_caller_frame(fp,addr);
if (caller_addr=nil) then
break;
Writeln(f,BackTraceStrFunc(caller_addr));
@ -1163,9 +1165,9 @@ Begin
Inc(i);
If ((i>max_frame_dump) and is_dev) or (i>256) Then
break;
prevbp:=bp;
prevfp:=fp;
prevaddr:=addr;
bp:=caller_frame;
fp:=caller_frame;
addr:=caller_addr;
End;
{$ifdef FPC_HAS_FEATURE_EXCEPTIONS}

2
rtl/inc/systemh.inc
View File

@ -1270,7 +1270,7 @@ Function Paramcount:Longint;
Function ParamStr(l:Longint):string;
{$endif FPC_HAS_FEATURE_COMMANDARGS}
Procedure Dump_Stack(var f : text;bp:pointer;addr : pointer = nil);
Procedure Dump_Stack(var f : text;fp:pointer;addr : pointer = nil);
{$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
procedure DumpExceptionBackTrace(var f:text);
{$endif FPC_HAS_FEATURE_EXCEPTIONS}