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

Move getptruint/putptruint methods to tentfile class to allow use with ppudump

Browse Source 
git-svn-id: trunk@37241 -
This commit is contained in:
pierre 2017-09-17 20:41:51 +00:00
parent 6791127952
commit 97241c46b2
2 changed files with 44 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
compiler/entfile.pas
View File

@ -271,6 +271,7 @@ type
function getaint:{$ifdef generic_cpu}int64{$else}aint{$endif};
function getasizeint:{$ifdef generic_cpu}int64{$else}asizeint{$endif};
function getpuint:{$ifdef generic_cpu}qword{$else}puint{$endif};
function getptruint:{$ifdef generic_cpu}qword{$else}TConstPtrUInt{$endif};
function getaword:{$ifdef generic_cpu}qword{$else}aword{$endif};
function getreal:entryreal;
function getrealsize(sizeofreal : longint):entryreal;
@ -297,6 +298,7 @@ type
procedure putaint(i:aint);
procedure putasizeint(i:asizeint);
procedure putpuint(i:puint);
procedure putptruint(v:TConstPtrUInt);
procedure putaword(i:aword);
procedure putreal(d:entryreal);
procedure putstring(const s:string);
@ -759,7 +761,15 @@ begin
else if CpuAddrBitSize[tsystemcpu(header^.cpu)]=32 then
result:=getlongint
else if CpuAddrBitSize[tsystemcpu(header^.cpu)]=16 then
result:=smallint(getword)
begin
{ result:=smallint(getword);
would have been logical, but it contradicts
definition of asizeint in globtype unit,
which uses 32-bit lngint type even for 16-bit
address size, to be able to cope with
I8086 seg:ofs huge addresses }
result:=getlongint;
end
else
begin
error:=true;
@ -791,7 +801,7 @@ begin
else if CpuAddrBitSize[tsystemcpu(header^.cpu)]=32 then
result:=getdword
else if CpuAddrBitSize[tsystemcpu(header^.cpu)]=16 then
result:=getbyte
result:=getword
else
begin
error:=true;
@ -810,6 +820,27 @@ begin
end;
function tentryfile.getptruint:{$ifdef generic_cpu}qword{$else}TConstPtrUInt{$endif};
{$ifdef generic_cpu}
var
header : pentryheader;
{$endif generic_cpu}
begin
{$ifdef generic_cpu}
header:=getheaderaddr;
if CpuAddrBitSize[tsystemcpu(header^.cpu)]=64 then
result:=getqword
else result:=getdword;
{$else not generic_cpu}
{$if sizeof(TConstPtrUInt)=8}
result:=tconstptruint(getint64);
{$else}
result:=TConstPtrUInt(getlongint);
{$endif}
{$endif not generic_cpu}
end;
function tentryfile.getaword:{$ifdef generic_cpu}qword{$else}aword{$endif};
{$ifdef generic_cpu}
var
@ -1209,6 +1240,17 @@ begin
putdata(i,sizeof(puint));
end;
procedure tentryfile.putptruint(v:TConstPtrUInt);
begin
{$if sizeof(TConstPtrUInt)=8}
putint64(int64(v));
{$else}
putlongint(longint(v));
{$endif}
end;
procedure tentryfile.putaword(i:aword);
begin

22
compiler/symtype.pas
View File

@ -193,14 +193,12 @@ interface
procedure checkerror;
procedure getguid(var g: tguid);
function getexprint:Tconstexprint;
function getptruint:TConstPtrUInt;
procedure getposinfo(var p:tfileposinfo);
procedure getderef(var d:tderef);
function getpropaccesslist:tpropaccesslist;
function getasmsymbol:tasmsymbol;
procedure putguid(const g: tguid);
procedure putexprint(const v:tconstexprint);
procedure PutPtrUInt(v:TConstPtrUInt);
procedure putposinfo(const p:tfileposinfo);
procedure putderef(const d:tderef);
procedure putpropaccesslist(p:tpropaccesslist);
@ -897,16 +895,6 @@ implementation
end;
function tcompilerppufile.getPtrUInt:TConstPtrUInt;
begin
{$if sizeof(TConstPtrUInt)=8}
result:=tconstptruint(getint64);
{$else}
result:=TConstPtrUInt(getlongint);
{$endif}
end;
procedure tcompilerppufile.getposinfo(var p:tfileposinfo);
var
info : byte;
@ -1098,16 +1086,6 @@ implementation
end;
procedure tcompilerppufile.PutPtrUInt(v:TConstPtrUInt);
begin
{$if sizeof(TConstPtrUInt)=8}
putint64(int64(v));
{$else}
putlongint(longint(v));
{$endif}
end;
procedure tcompilerppufile.putderef(const d:tderef);
var
oldcrc : boolean;