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

* get_addr function renamed to get_pc_addr

Browse Source 
+ get_caller_stackinfo procedure added.

git-svn-id: trunk@21707 -
This commit is contained in:
pierre 2012-06-25 22:17:49 +00:00
parent 117c083003
commit f340ef87e3
6 changed files with 174 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
rtl/i386/i386.inc
View File

@ -1061,8 +1061,8 @@ end;
{$ENDIF not INTERNAL_BACKTRACE}
{$define FPC_SYSTEM_HAS_GET_ADDR}
Function Get_addr : Pointer;assembler;nostackframe;
{$define FPC_SYSTEM_HAS_GET_PC_ADDR}
Function Get_pc_addr : Pointer;assembler;nostackframe;
asm
movl (%esp),%eax
end;

60
rtl/inc/heaptrc.pp
View File

@ -331,14 +331,21 @@ end;
procedure dump_already_free(p : pheap_mem_info;var ptext : text);
var
bp, pcaddr : pointer;
begin
Writeln(ptext,'Marked memory at $',HexStr(pointer(p)+sizeof(theap_mem_info)),' released');
call_free_stack(p,ptext);
Writeln(ptext,'freed again at');
dump_stack(ptext,get_caller_frame(get_frame));
bp:=get_frame;
pcaddr:=get_pc_addr;
get_caller_stackinfo(bp,pcaddr);
dump_stack(ptext,bp,pcaddr);
end;
procedure dump_error(p : pheap_mem_info;var ptext : text);
var
bp, pcaddr : pointer;
begin
Writeln(ptext,'Marked memory at $',HexStr(pointer(p)+sizeof(theap_mem_info)),' invalid');
Writeln(ptext,'Wrong signature $',hexstr(p^.sig,8),' instead of ',hexstr(calculate_sig(p),8));
@ -347,7 +354,10 @@ begin
write(ptext, 'Block content: ');
printhex(pointer(p) + sizeof(theap_mem_info), p^.size, ptext);
end;
dump_stack(ptext,get_caller_frame(get_frame));
bp:=get_frame;
pcaddr:=get_pc_addr;
get_caller_stackinfo(bp,pcaddr);
dump_stack(ptext,bp,pcaddr);
end;
{$ifdef EXTRA}
@ -367,10 +377,15 @@ end;
{$endif EXTRA}
procedure dump_wrong_size(p : pheap_mem_info;size : ptruint;var ptext : text);
var
bp, pcaddr : pointer;
begin
Writeln(ptext,'Marked memory at $',HexStr(pointer(p)+sizeof(theap_mem_info)),' invalid');
Writeln(ptext,'Wrong size : ',p^.size,' allocated ',size,' freed');
dump_stack(ptext,get_caller_frame(get_frame));
bp:=get_frame;
pcaddr:=get_pc_addr;
get_caller_stackinfo(bp,pcaddr);
dump_stack(ptext,bp,pcaddr);
{ the check is done to be sure that the procvar is not overwritten }
if assigned(p^.extra_info) and
(p^.extra_info^.check=$12345678) and
@ -445,7 +460,7 @@ Function TraceGetMem(size:ptruint):pointer;
var
allocsize,i : ptruint;
oldbp,
bp : pointer;
bp,pcaddr : pointer;
pl : pdword;
p : pointer;
pp : pheap_mem_info;
@ -509,15 +524,16 @@ begin
{ clear the memory }
fillchar(p^,size,#255);
{ retrieve backtrace info }
bp:=get_caller_frame(get_frame);
bp:=get_frame;
pcaddr:=get_pc_addr;
get_caller_stackinfo(bp,pcaddr);
{ valid bp? }
if (bp>=StackBottom) and (bp<(StackBottom + StackLength)) then
for i:=1 to tracesize do
begin
pp^.calls[i]:=get_caller_addr(bp);
oldbp:=bp;
bp:=get_caller_frame(bp);
get_caller_stackinfo(bp,pcaddr);
pp^.calls[i]:=pcaddr;
if (bp<oldbp) or (bp>(StackBottom + StackLength)) then
break;
end;
@ -553,7 +569,7 @@ function CheckFreeMemSize(loc_info: pheap_info; pp: pheap_mem_info;
size, ppsize: ptruint): boolean; inline;
var
i: ptruint;
bp : pointer;
bp,pcaddr : pointer;
ptext : ^text;
{$ifdef EXTRA}
pp2 : pheap_mem_info;
@ -612,12 +628,15 @@ begin
end
else
begin
bp:=get_caller_frame(get_frame);
bp:=get_frame;
pcaddr:=get_pc_addr;
get_caller_stackinfo(bp,pcaddr);
if (bp>=StackBottom) and (bp<(StackBottom + StackLength)) then
for i:=(tracesize div 2)+1 to tracesize do
begin
pp^.calls[i]:=get_caller_addr(bp);
bp:=get_caller_frame(bp);
get_caller_stackinfo(bp,pcaddr);
pp^.calls[i]:=pcaddr;
if not((bp>=StackBottom) and (bp<(StackBottom + StackLength))) then
break;
end;
@ -775,7 +794,8 @@ var
movesize,
i : ptruint;
oldbp,
bp : pointer;
bp,
pcaddr : pointer;
pl : pdword;
pp : pheap_mem_info;
oldsize,
@ -890,13 +910,15 @@ begin
inc(loc_info^.getmem_size,size);
inc(loc_info^.getmem8_size,(size+7) and not 7);
{ generate new backtrace }
bp:=get_caller_frame(get_frame);
bp:=get_frame;
pcaddr:=get_pc_addr;
get_caller_stackinfo(bp,pcaddr);
if (bp>=StackBottom) and (bp<(StackBottom + StackLength)) then
for i:=1 to tracesize do
begin
pp^.calls[i]:=get_caller_addr(bp);
oldbp:=bp;
bp:=get_caller_frame(bp);
get_caller_stackinfo(bp,pcaddr);
pp^.calls[i]:=pcaddr;
if (bp<oldbp) or (bp>(StackBottom + StackLength)) then
break;
end;
@ -979,6 +1001,7 @@ var
{$ifdef morphos}
stack_top: longword;
{$endif morphos}
bp,pcaddr : pointer;
ptext : ^text;
label
_exit;
@ -1136,7 +1159,10 @@ begin
end;
end;
writeln(ptext^,'pointer $',hexstr(p),' does not point to valid memory block');
dump_stack(ptext^,get_caller_frame(get_frame));
bp:=get_frame;
pcaddr:=get_pc_addr;
get_caller_stackinfo(bp,pcaddr);
dump_stack(ptext^,bp,pcaddr);
runerror(204);
_exit:
end;

56
rtl/inc/system.inc
View File

@ -669,43 +669,60 @@ End;
Miscellaneous
*****************************************************************************}
{$ifndef FPC_SYSTEM_HAS_GET_ADDR}
{$ifndef FPC_SYSTEM_HAS_GET_PC_ADDR}
{ This provides a dummy implementation
of get_addr function, for CPU's that don't need
of get_pc_addr function, for CPU's that don't need
the instruction address to walk the stack. }
function get_addr : pointer;
function get_pc_addr : pointer;
begin
get_addr:=nil;
get_pc_addr:=nil;
end;
{$endif ndef FPC_SYSTEM_HAS_GET_ADDR}
{$endif ndef FPC_SYSTEM_HAS_GET_PC_ADDR}
{$ifndef FPC_SYSTEM_HAS_GET_CALLER_STACKINFO}
{ This provides a simpel implementation
of get_caller_stackinfo procedure,
using get_caller_addr and get_caller_frame
functions. }
procedure get_caller_stackinfo(var framebp,addr : pointer);
var
nextbp,nextaddr : pointer;
begin
nextbp:=get_caller_frame(framebp,addr);
nextaddr:=get_caller_addr(framebp,addr);
framebp:=nextbp;
addr:=nextaddr;
end;
{$endif ndef FPC_SYSTEM_HAS_GET_CALLER_STACKINFO}
procedure fpc_rangeerror;[public,alias:'FPC_RANGEERROR']; compilerproc;
begin
HandleErrorAddrFrame(201,get_addr,get_frame);
HandleErrorAddrFrame(201,get_pc_addr,get_frame);
end;
procedure fpc_divbyzero;[public,alias:'FPC_DIVBYZERO']; compilerproc;
begin
HandleErrorAddrFrame(200,get_addr,get_frame);
HandleErrorAddrFrame(200,get_pc_addr,get_frame);
end;
procedure fpc_overflow;[public,alias:'FPC_OVERFLOW']; compilerproc;
begin
HandleErrorAddrFrame(215,get_addr,get_frame);
HandleErrorAddrFrame(215,get_pc_addr,get_frame);
end;
procedure fpc_threaderror; [public,alias:'FPC_THREADERROR'];
begin
HandleErrorAddrFrame(6,get_addr,get_frame);
HandleErrorAddrFrame(6,get_pc_addr,get_frame);
end;
procedure fpc_invalidpointer; [public,alias:'FPC_INVALIDPOINTER'];
begin
HandleErrorAddrFrame(216,get_addr,get_frame);
HandleErrorAddrFrame(216,get_pc_addr,get_frame);
end;
@ -719,7 +736,7 @@ begin
begin
l:=HInOutRes^;
HInOutRes^:=0;
HandleErrorAddrFrame(l,get_addr,get_frame);
HandleErrorAddrFrame(l,get_pc_addr,get_frame);
end;
end;
@ -748,7 +765,7 @@ begin
begin
if assigned(SafeCallErrorProc) then
SafeCallErrorProc(res,get_frame);
HandleErrorAddrFrame(229,get_addr,get_frame);
HandleErrorAddrFrame(229,get_pc_addr,get_frame);
end;
result:=res;
end;
@ -1035,15 +1052,20 @@ Procedure HandleError (Errno : longint);[public,alias : 'FPC_HANDLEERROR'];
Internal function should ALWAYS call HandleError instead of RunError.
}
begin
HandleErrorAddrFrame(Errno,get_frame,get_addr);
HandleErrorAddrFrame(Errno,get_pc_addr,get_frame);
end;
procedure RunError(w : word);[alias: 'FPC_RUNERROR'];
var
bp,pcaddr : pointer;
begin
errorcode:=w;
erroraddr:=get_caller_addr(get_frame,get_addr);
errorbase:=get_caller_frame(get_frame,get_addr);
pcaddr:=get_pc_addr;
bp:=get_frame;
get_caller_stackinfo(bp,pcaddr);
erroraddr:=pcaddr;
errorbase:=bp;
Halt(errorcode);
end;
@ -1283,7 +1305,7 @@ procedure fpc_AbstractErrorIntern;compilerproc;[public,alias : 'FPC_ABSTRACTERRO
begin
If pointer(AbstractErrorProc)<>nil then
AbstractErrorProc();
HandleErrorAddrFrame(211,get_addr,get_frame);
HandleErrorAddrFrame(211,get_pc_addr,get_frame);
end;
@ -1293,7 +1315,7 @@ begin
if pointer(AssertErrorProc)<>nil then
AssertErrorProc(Msg,FName,LineNo,ErrorAddr)
else
HandleErrorAddrFrame(227,get_addr,get_frame);
HandleErrorAddrFrame(227,get_pc_addr,get_frame);
end;

3
rtl/inc/systemh.inc
View File

@ -1066,10 +1066,11 @@ function get_caller_frame(framebp:pointer;addr:pointer=nil):pointer;[INTERNPROC:
function get_frame:pointer;{$ifdef SYSTEMINLINE}inline;{$endif}
{$ENDIF}
Function Get_addr : Pointer;
Function Get_pc_addr : Pointer;
function get_caller_addr(framebp:pointer;addr:pointer=nil):pointer;
function get_caller_frame(framebp:pointer;addr:pointer=nil):pointer;
procedure get_caller_stackinfo(var framebp,addr : pointer);
Function IOResult:Word;
Function Sptr:Pointer;[internconst:fpc_in_const_ptr];

97
rtl/mips/mips.inc
View File

@ -74,21 +74,96 @@ function get_frame:pointer;assembler;nostackframe;
end;
{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
function get_caller_addr(framebp:pointer;addr:pointer=nil):pointer;assembler;nostackframe;
asm
// lw $2,4($4) // #movl 4(%eax),%eax
lui $2,0
{ Try to find previous $fp,$ra register pair
reset both to nil if failure }
{$define FPC_SYSTEM_HAS_GET_CALLER_STACKINFO}
procedure get_caller_stackinfo(var framebp,addr : pointer);
const
instr_size = 4;
MAX_INSTRUCTIONS = 64000;
type
instr_p = pdword;
reg_p = ppointer;
var
instr,stackpos : dword;
i,LocalSize : longint;
ra_offset, s8_offset : longint;
current_ra : pointer;
begin
{ Here we need to use GDB approach,
starting at addr
go back to lower $ra values until we find a
position with ADDIU $sp,$sp,-LocalSize
}
Try
current_ra:=addr;
ra_offset:=-1;
s8_offset:=-1;
i:=0;
LocalSize:=0;
repeat
inc(i);
dec(current_ra,4);
instr:=instr_p(current_ra)^;
if (instr shr 16 = $27bd) then
begin
{ we found the instruction,
local size is the lo part }
LocalSize:=smallint(instr and $ffff);
break;
end;
until i> MAX_INSTRUCTIONS;
if LocalSize <> 0 then
begin
repeat
inc(current_ra,4);
instr:=instr_p(current_ra)^;
if (instr shr 16 = $afbf) then
ra_offset:=smallint(instr and $ffff)
else if (instr shr 16 = $afbe) then
s8_offset:=smallint(instr and $ffff);
until (current_ra >= addr)
or ((ra_offset<>-1) and (s8_offset<>-1));
if ra_offset<>-1 then
begin
stackpos:=dword(framebp+LocalSize+ra_offset);
addr:=reg_p(stackpos)^;
end
else
addr:=nil;
if s8_offset<>-1 then
begin
stackpos:=dword(framebp+LocalSize+s8_offset);
framebp:=reg_p(stackpos)^;
end
else
framebp:=nil;
end;
Except
framebp:=nil;
addr:=nil;
end;
end;
{$define FPC_SYSTEM_HAS_GET_PC_ADDR}
function get_pc_addr : pointer;assembler;nostackframe;
asm
move $2,$31
end;
{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
function get_caller_addr(framebp:pointer;addr:pointer=nil):pointer;
begin
get_caller_stackinfo(framebp,addr);
get_caller_addr:=addr;
end;
{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
function get_caller_frame(framebp:pointer;addr:pointer=nil):pointer;assembler;nostackframe;
asm
// lw $2,0($4) // #movl (%eax),%eax
lui $2,0
end;
function get_caller_frame(framebp:pointer;addr:pointer=nil):pointer;
begin
get_caller_stackinfo(framebp,addr);
get_caller_frame:=framebp;
end;
{$define FPC_SYSTEM_HAS_SPTR}
function Sptr:Pointer;assembler;nostackframe;

4
rtl/x86_64/x86_64.inc
View File

@ -35,8 +35,8 @@ asm
end;
{$ENDIF not INTERNAL_BACKTRACE}
{$define FPC_SYSTEM_HAS_GET_ADDR}
function get_addr:pointer;assembler;
{$define FPC_SYSTEM_HAS_GET_PC_ADDR}
function get_pc_addr:pointer;assembler;
asm
movq (%rsp),%rax
end;