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

* fixed dumping objectdefs after r14185

Browse Source 
+ dump wpo info

git-svn-id: trunk@14484 -
This commit is contained in:
Jonas Maebe 2009-12-27 14:26:37 +00:00
parent 616289f1c8
commit d219109b16
1 changed files with 97 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

134
compiler/utils/ppudump.pp
View File

@ -630,7 +630,7 @@ begin
end; end;
procedure readderef; procedure readderef(const derefspace: string);
type type
tdereftype = (deref_nil, tdereftype = (deref_nil,
deref_unit, deref_unit,
@ -653,7 +653,7 @@ begin
writeln('!! Error: Deref idx ',idx,' > ',derefdatalen); writeln('!! Error: Deref idx ',idx,' > ',derefdatalen);
exit; exit;
end; end;
write('(',idx,') '); write(derefspace,'(',idx,') ');
pdata:=@derefdata[idx]; pdata:=@derefdata[idx];
i:=0; i:=0;
n:=pdata[i]; n:=pdata[i];
@ -725,7 +725,7 @@ const
var var
sl : tsltype; sl : tsltype;
begin begin
readderef; readderef('');
repeat repeat
sl:=tsltype(ppufile.getbyte); sl:=tsltype(ppufile.getbyte);
if sl=sl_none then if sl=sl_none then
@ -735,14 +735,14 @@ begin
sl_call, sl_call,
sl_load, sl_load,
sl_subscript : sl_subscript :
readderef; readderef('');
sl_absolutetype, sl_absolutetype,
sl_typeconv : sl_typeconv :
readderef; readderef('');
sl_vec : sl_vec :
begin begin
writeln(ppufile.getlongint); writeln(ppufile.getlongint);
readderef; readderef('');
end; end;
end; end;
until false; until false;
@ -889,7 +889,7 @@ begin
writeln(space,'** Definition Id ',ppufile.getlongint,' **'); writeln(space,'** Definition Id ',ppufile.getlongint,' **');
writeln(space,s); writeln(space,s);
write (space,' Type symbol : '); write (space,' Type symbol : ');
readderef; readderef('');
write (space,' DefOptions : '); write (space,' DefOptions : ');
ppufile.getsmallset(defoptions); ppufile.getsmallset(defoptions);
if defoptions<>[] then if defoptions<>[] then
@ -1027,7 +1027,7 @@ begin
if df_specialization in defoptions then if df_specialization in defoptions then
begin begin
write (space,' Orig. GenericDef : '); write (space,' Orig. GenericDef : ');
readderef; readderef('');
end; end;
current_defoptions:=defoptions; current_defoptions:=defoptions;
end; end;
@ -1234,7 +1234,7 @@ var
tempbuf : array[0..255] of byte; tempbuf : array[0..255] of byte;
begin begin
write(space,' Return type : '); write(space,' Return type : ');
readderef; readderef('');
writeln(space,' Fpu used : ',ppufile.getbyte); writeln(space,' Fpu used : ',ppufile.getbyte);
proctypeoption:=tproctypeoption(ppufile.getbyte); proctypeoption:=tproctypeoption(ppufile.getbyte);
write(space,' TypeOption : '); write(space,' TypeOption : ');
@ -1350,7 +1350,7 @@ begin
writeln(space,' Regable : ',Varregable2Str(ppufile.getbyte)); writeln(space,' Regable : ',Varregable2Str(ppufile.getbyte));
writeln(space,' Addr Taken : ',(ppufile.getbyte<>0)); writeln(space,' Addr Taken : ',(ppufile.getbyte<>0));
write (space,' Var Type : '); write (space,' Var Type : ');
readderef; readderef('');
ppufile.getsmallset(varoptions); ppufile.getsmallset(varoptions);
if varoptions<>[] then if varoptions<>[] then
begin begin
@ -1522,6 +1522,64 @@ begin
end; end;
procedure ReadCreatedObjTypes;
var
i,j,
len,
bssize: longint;
bs: pbyte;
begin
if ppufile.readentry<>ibcreatedobjtypes then
begin
writeln('!! ibcreatedobjtypes entry not found');
ppufile.skipdata(ppufile.entrysize);
exit
end;
writeln;
writeln(space,'WPO info');
writeln(space,'--------');
len:=ppufile.getlongint;
writeln(space,'** Instantiated Object/Class types: ',len,' **');
space:=space+' ';
for i:=0 to len-1 do
readderef(space);
setlength(space,length(space)-2);
len:=ppufile.getlongint;
writeln(space,'** Instantiated ClassRef types: ',len,' **');
space:=space+' ';
for i:=0 to len-1 do
readderef(space);
setlength(space,length(space)-2);
len:=ppufile.getlongint;
writeln(space,'** Possibly instantiated ClassRef types : ',len,' **');
space:=space+' ';
for i:=0 to len-1 do
readderef(space);
setlength(space,length(space)-2);
len:=ppufile.getlongint;
writeln(space,'** Class types with called virtual methods info : ',len,' **');
space:=space+' ';
for i:=0 to len-1 do
begin
write(space,'Class def : ');
readderef('');
write(space+' ','Called vmtentries : ');
bssize:=ppufile.getlongint;
getmem(bs,bssize);
ppufile.readdata(bs^,bssize);
for j:=0 to bssize*8-1 do
if (((bs+j shr 3)^ shr (j and 7)) and 1) <> 0 then
write(j,', ');
writeln;
freemem(bs);
end;
setlength(space,length(space)-2);
end;
{**************************************************************************** {****************************************************************************
Read Symbols Part Read Symbols Part
****************************************************************************} ****************************************************************************}
@ -1575,7 +1633,7 @@ begin
begin begin
readcommonsym('Type symbol '); readcommonsym('Type symbol ');
write(space,' Result Type : '); write(space,' Result Type : ');
readderef; readderef('');
end; end;
ibprocsym : ibprocsym :
@ -1585,7 +1643,7 @@ begin
for i:=1 to len do for i:=1 to len do
begin begin
write(space,' Definition : '); write(space,' Definition : ');
readderef; readderef('');
end; end;
end; end;
@ -1597,13 +1655,13 @@ begin
constord : constord :
begin begin
write (space,' OrdinalType : '); write (space,' OrdinalType : ');
readderef; readderef('');
writeln(space,' Value : ',constexp.tostr(getexprint)); writeln(space,' Value : ',constexp.tostr(getexprint));
end; end;
constpointer : constpointer :
begin begin
write (space,' PointerType : '); write (space,' PointerType : ');
readderef; readderef('');
writeln(space,' Value : ',getlongint) writeln(space,' Value : ',getlongint)
end; end;
conststring, conststring,
@ -1622,7 +1680,7 @@ begin
constset : constset :
begin begin
write (space,' Set Type : '); write (space,' Set Type : ');
readderef; readderef('');
for i:=1to 4 do for i:=1to 4 do
begin begin
write (space,' Value : '); write (space,' Value : ');
@ -1685,7 +1743,7 @@ begin
begin begin
readabstractvarsym('Global Variable symbol ',varoptions); readabstractvarsym('Global Variable symbol ',varoptions);
write (space,' DefaultConst : '); write (space,' DefaultConst : ');
readderef; readderef('');
if (vo_has_mangledname in varoptions) then if (vo_has_mangledname in varoptions) then
writeln(space,' Mangledname : ',getstring); writeln(space,' Mangledname : ',getstring);
end; end;
@ -1694,14 +1752,14 @@ begin
begin begin
readabstractvarsym('Local Variable symbol ',varoptions); readabstractvarsym('Local Variable symbol ',varoptions);
write (space,' DefaultConst : '); write (space,' DefaultConst : ');
readderef; readderef('');
end; end;
ibparavarsym : ibparavarsym :
begin begin
readabstractvarsym('Parameter Variable symbol ',varoptions); readabstractvarsym('Parameter Variable symbol ',varoptions);
write (space,' DefaultConst : '); write (space,' DefaultConst : ');
readderef; readderef('');
writeln(space,' ParaNr : ',getword); writeln(space,' ParaNr : ',getword);
writeln(space,' VarState : ',getbyte); writeln(space,' VarState : ',getbyte);
if (vo_has_explicit_paraloc in varoptions) then if (vo_has_explicit_paraloc in varoptions) then
@ -1715,7 +1773,7 @@ begin
begin begin
readcommonsym('Enumeration symbol '); readcommonsym('Enumeration symbol ');
write (space,' Definition : '); write (space,' Definition : ');
readderef; readderef('');
writeln(space,' Value : ',getlongint); writeln(space,' Value : ',getlongint);
end; end;
@ -1749,13 +1807,13 @@ begin
i:=getlongint; i:=getlongint;
writeln(space,' PropOptions : ',i); writeln(space,' PropOptions : ',i);
write (space,' OverrideProp : '); write (space,' OverrideProp : ');
readderef; readderef('');
write (space,' Prop Type : '); write (space,' Prop Type : ');
readderef; readderef('');
writeln(space,' Index : ',getlongint); writeln(space,' Index : ',getlongint);
writeln(space,' Default : ',getlongint); writeln(space,' Default : ',getlongint);
write (space,' Index Type : '); write (space,' Index Type : ');
readderef; readderef('');
write (space,' Readaccess : '); write (space,' Readaccess : ');
readpropaccesslist(space+' Sym: '); readpropaccesslist(space+' Sym: ');
write (space,' Writeaccess : '); write (space,' Writeaccess : ');
@ -1832,7 +1890,7 @@ begin
begin begin
readcommondef('Pointer definition'); readcommondef('Pointer definition');
write (space,' Pointed Type : '); write (space,' Pointed Type : ');
readderef; readderef('');
writeln(space,' Is Far : ',(getbyte<>0)); writeln(space,' Is Far : ',(getbyte<>0));
end; end;
@ -1873,9 +1931,9 @@ begin
begin begin
readcommondef('Array definition'); readcommondef('Array definition');
write (space,' Element type : '); write (space,' Element type : ');
readderef; readderef('');
write (space,' Range Type : '); write (space,' Range Type : ');
readderef; readderef('');
writeln(space,' Range : ',getaint,' to ',getaint); writeln(space,' Range : ',getaint,' to ',getaint);
write (space,' Options : '); write (space,' Options : ');
readarraydefoptions; readarraydefoptions;
@ -1890,9 +1948,9 @@ begin
writeln(space,' Number : ',getword); writeln(space,' Number : ',getword);
writeln(space,' Level : ',getbyte); writeln(space,' Level : ',getbyte);
write (space,' Class : '); write (space,' Class : ');
readderef; readderef('');
write (space,' Procsym : '); write (space,' Procsym : ');
readderef; readderef('');
write (space,' File Pos : '); write (space,' File Pos : ');
readposinfo; readposinfo;
writeln(space,' Visibility : ',Visibility2Str(ppufile.getbyte)); writeln(space,' Visibility : ',Visibility2Str(ppufile.getbyte));
@ -1902,7 +1960,7 @@ begin
begin begin
{ library symbol for AmigaOS/MorphOS } { library symbol for AmigaOS/MorphOS }
write (space,' Library symbol : '); write (space,' Library symbol : ');
readderef; readderef('');
end; end;
if (po_has_importdll in procoptions) then if (po_has_importdll in procoptions) then
writeln(space,' Import DLL : ',getstring); writeln(space,' Import DLL : ',getstring);
@ -1918,7 +1976,7 @@ begin
if (po_has_inlininginfo in procoptions) then if (po_has_inlininginfo in procoptions) then
begin begin
write (space,' FuncretSym : '); write (space,' FuncretSym : ');
readderef; readderef('');
ppufile.getsmallset(procinfooptions); ppufile.getsmallset(procinfooptions);
writeln(space,' ProcInfoOptions : ',dword(procinfooptions)); writeln(space,' ProcInfoOptions : ',dword(procinfooptions));
end; end;
@ -2023,12 +2081,13 @@ begin
end; end;
writeln(space,' Name of Class : ',getstring); writeln(space,' Name of Class : ',getstring);
writeln(space,' External name : ',getstring); writeln(space,' External name : ',getstring);
writeln(space,' Import lib : ',getstring);
writeln(space,' DataSize : ',getaint); writeln(space,' DataSize : ',getaint);
writeln(space,' FieldAlign : ',getbyte); writeln(space,' FieldAlign : ',getbyte);
writeln(space,' RecordAlign : ',getbyte); writeln(space,' RecordAlign : ',getbyte);
writeln(space,' Vmt offset : ',getlongint); writeln(space,' Vmt offset : ',getlongint);
write (space, ' Ancestor Class : '); write (space, ' Ancestor Class : ');
readderef; readderef('');
write (space,' Options : '); write (space,' Options : ');
readobjectdefoptions; readobjectdefoptions;
@ -2046,7 +2105,7 @@ begin
for j:=1 to l do for j:=1 to l do
begin begin
write(space,' '); write(space,' ');
readderef; readderef('');
writeln(space,' Visibility: ',Visibility2Str(getbyte)); writeln(space,' Visibility: ',Visibility2Str(getbyte));
end; end;
@ -2057,7 +2116,7 @@ begin
for j:=1 to l do for j:=1 to l do
begin begin
write (space,' - Definition : '); write (space,' - Definition : ');
readderef; readderef('');
writeln(space,' IOffset : ',getlongint); writeln(space,' IOffset : ',getlongint);
end; end;
end; end;
@ -2065,7 +2124,7 @@ begin
if df_copied_def in current_defoptions then if df_copied_def in current_defoptions then
begin begin
writeln(' Copy of def: '); writeln(' Copy of def: ');
readderef; readderef('');
end; end;
if not EndOfEntry then if not EndOfEntry then
@ -2089,7 +2148,7 @@ begin
1 : begin 1 : begin
writeln('Typed'); writeln('Typed');
write (space,' File of Type : '); write (space,' File of Type : ');
readderef; readderef('');
end; end;
2 : writeln('Untyped'); 2 : writeln('Untyped');
end; end;
@ -2108,7 +2167,7 @@ begin
begin begin
readcommondef('Enumeration type definition'); readcommondef('Enumeration type definition');
write(space,'Base enumeration type : '); write(space,'Base enumeration type : ');
readderef; readderef('');
writeln(space,' Smallest element : ',getaint); writeln(space,' Smallest element : ',getaint);
writeln(space,' Largest element : ',getaint); writeln(space,' Largest element : ',getaint);
writeln(space,' Size : ',getaint); writeln(space,' Size : ',getaint);
@ -2118,14 +2177,14 @@ begin
begin begin
readcommondef('Class reference definition'); readcommondef('Class reference definition');
write (space,' Pointed Type : '); write (space,' Pointed Type : ');
readderef; readderef('');
end; end;
ibsetdef : ibsetdef :
begin begin
readcommondef('Set definition'); readcommondef('Set definition');
write (space,' Element type : '); write (space,' Element type : ');
readderef; readderef('');
writeln(space,' Size : ',getaint); writeln(space,' Size : ',getaint);
writeln(space,' Set Base : ',getaint); writeln(space,' Set Base : ',getaint);
writeln(space,' Set Max : ',getaint); writeln(space,' Set Max : ',getaint);
@ -2442,6 +2501,7 @@ begin
else else
ppufile.skipuntilentry(ibendsyms); ppufile.skipuntilentry(ibendsyms);
end; end;
ReadCreatedObjTypes;
{shutdown ppufile} {shutdown ppufile}
ppufile.closefile; ppufile.closefile;
ppufile.free; ppufile.free;