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

* m68k updates merged

Browse Source
This commit is contained in:
peter 2001-07-29 13:43:57 +00:00
parent 33f9b586e7
commit ce52d581b3
2 changed files with 31 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
rtl/inc/heaptrc.pp
View File

@ -21,6 +21,8 @@ interface
{$R-} {$R-}
{$endif} {$endif}
{$goto on}
Procedure DumpHeap; Procedure DumpHeap;
Procedure MarkHeap; Procedure MarkHeap;
@ -1146,7 +1148,10 @@ finalization
end. end.
{ {
$Log$ $Log$
Revision 1.14 2001-06-06 17:20:22 jonas Revision 1.15 2001-07-29 13:43:57 peter
* m68k updates merged
Revision 1.14 2001/06/06 17:20:22 jonas
* fixed wrong typed constant procvars in preparation of my fix which will * fixed wrong typed constant procvars in preparation of my fix which will
disallow them in FPC mode (plus some other unmerged changes since disallow them in FPC mode (plus some other unmerged changes since
LAST_MERGE) LAST_MERGE)

34
rtl/inc/lineinfo.pp
View File

@ -26,7 +26,7 @@ interface
{$S-} {$S-}
{$endif} {$endif}
procedure GetLineInfo(addr:longint;var func,source:string;var line:longint); procedure GetLineInfo(addr:dword;var func,source:string;var line:longint);
implementation implementation
@ -54,7 +54,7 @@ type
ntype : byte; ntype : byte;
nother : byte; nother : byte;
ndesc : word; ndesc : word;
nvalue : longint; nvalue : dword;
end; end;
{ We use static variable so almost no stack is required, and is thus { We use static variable so almost no stack is required, and is thus
@ -394,8 +394,18 @@ begin
if filesize(f)<sizeof(telf32header) then if filesize(f)<sizeof(telf32header) then
exit; exit;
blockread(f,elfheader,sizeof(telf32header)); blockread(f,elfheader,sizeof(telf32header));
if elfheader.magic0123<>$464c457f then {$ifdef ENDIAN_LITTLE}
if elfheader.magic0123<>$464c457f then
exit; exit;
{$endif ENDIAN_LITTLE}
{$ifdef ENDIAN_BIG}
if elfheader.magic0123<>$7f454c46 then
exit;
{ this seems to be at least the case for m68k cpu PM }
{$ifdef m68k}
{StabsFunctionRelative:=false;}
{$endif m68k}
{$endif ENDIAN_BIG}
if elfheader.e_shentsize<>sizeof(telf32sechdr) then if elfheader.e_shentsize<>sizeof(telf32sechdr) then
exit; exit;
{ read section names } { read section names }
@ -486,7 +496,7 @@ begin
end; end;
procedure GetLineInfo(addr:longint;var func,source:string;var line:longint); procedure GetLineInfo(addr:dword;var func,source:string;var line:longint);
var var
res : {$ifdef tp}integer{$else}longint{$endif}; res : {$ifdef tp}integer{$else}longint{$endif};
stabsleft, stabsleft,
@ -608,11 +618,12 @@ var
source : string; source : string;
hs : string[32]; hs : string[32];
line : longint; line : longint;
Store : function (addr : longint) : string;
begin begin
GetLineInfo(addr,func,source,line); { reset to prevent infinite recursion if problems inside the code PM }
{ if there was an error with opening reset the hook to the system default } Store:=BackTraceStrFunc;
if not Opened then BackTraceStrFunc:=@SysBackTraceStr;
BackTraceStrFunc:=@SysBackTraceStr; GetLineInfo(dword(addr),func,source,line);
{ create string } { create string }
StabBackTraceStr:=' 0x'+HexStr(addr,8); StabBackTraceStr:=' 0x'+HexStr(addr,8);
if func<>'' then if func<>'' then
@ -628,6 +639,8 @@ begin
end; end;
StabBackTraceStr:=StabBackTraceStr+' of '+source; StabBackTraceStr:=StabBackTraceStr+' of '+source;
end; end;
if Opened then
BackTraceStrFunc:=Store;
end; end;
@ -641,7 +654,10 @@ finalization
end. end.
{ {
$Log$ $Log$
Revision 1.5 2000-12-18 14:01:11 jonas Revision 1.6 2001-07-29 13:43:57 peter
* m68k updates merged
Revision 1.5 2000/12/18 14:01:11 jonas
* added cardinal typecast to avoid signed evaluation * added cardinal typecast to avoid signed evaluation
Revision 1.4 2000/11/13 13:40:04 marco Revision 1.4 2000/11/13 13:40:04 marco