paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-23 18:51:35 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ get longer backtrace when redirected to file

Browse Source
This commit is contained in:
pierre 2000-04-14 12:17:12 +00:00
parent a63d58d57a
commit f1ab3ebad2
1 changed files with 10 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
rtl/inc/system.inc
View File

@ -514,18 +514,22 @@ Begin
Halt(0); Halt(0);
End; End;
function do_isdevice(handle:longint):boolean;forward;
Procedure dump_stack(var f : text;bp : Longint); Procedure dump_stack(var f : text;bp : Longint);
var var
i, prevbp : Longint; i, prevbp : Longint;
is_dev : boolean;
Begin Begin
prevbp:=bp-1; prevbp:=bp-1;
i:=0; i:=0;
is_dev:=do_isdevice(textrec(f).Handle);
while bp > prevbp Do while bp > prevbp Do
Begin Begin
Writeln(f,BackTraceStrFunc(get_caller_addr(bp))); Writeln(f,BackTraceStrFunc(get_caller_addr(bp)));
Inc(i); Inc(i);
If i>max_frame_dump Then If ((i>max_frame_dump) and is_dev) or (i>256) Then
exit; exit;
prevbp:=bp; prevbp:=bp;
bp:=get_caller_frame(bp); bp:=get_caller_frame(bp);
@ -617,7 +621,10 @@ end;
{ {
$Log$ $Log$
Revision 1.86 2000-04-02 09:39:25 florian Revision 1.87 2000-04-14 12:17:12 pierre
+ get longer backtrace when redirected to file
Revision 1.86 2000/04/02 09:39:25 florian
* halt in the finalization statement of a unit lead to an endless loop; fixed * halt in the finalization statement of a unit lead to an endless loop; fixed
Revision 1.85 2000/03/14 07:31:57 pierre Revision 1.85 2000/03/14 07:31:57 pierre
@ -689,4 +696,4 @@ end;
Revision 1.65 1999/07/28 12:58:22 peter Revision 1.65 1999/07/28 12:58:22 peter
* fixed assert() to push/pop registers * fixed assert() to push/pop registers
} }