mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-11 09:26:15 +02:00
* Fixed reading of float constant after changes in r20190. ppudump now read PPUs without fatal errors.
* Replaced assignment "has_errors:=true" by calling a new procedure SetHasErrors. It simplifies debugging - just set a breakpoint inside SetHasErrors and see the stack back trace to find out where the error has occurred. git-svn-id: trunk@23633 -
This commit is contained in:
parent
4eb660699c
commit
a530bb1bb0
@ -1,5 +1,5 @@
|
|||||||
{
|
{
|
||||||
Copyright (c) 1998-2002 by the FPC Development Team
|
Copyright (c) 1998-2013 by the FPC Development Team
|
||||||
|
|
||||||
Dumps the contents of a FPC unit file (PPU File)
|
Dumps the contents of a FPC unit file (PPU File)
|
||||||
|
|
||||||
@ -38,9 +38,9 @@ uses
|
|||||||
tokens;
|
tokens;
|
||||||
|
|
||||||
const
|
const
|
||||||
Version = 'Version 2.5.1';
|
Version = 'Version 2.7.1';
|
||||||
Title = 'PPU-Analyser';
|
Title = 'PPU-Analyser';
|
||||||
Copyright = 'Copyright (c) 1998-2010 by the Free Pascal Development Team';
|
Copyright = 'Copyright (c) 1998-2013 by the Free Pascal Development Team';
|
||||||
|
|
||||||
{ verbosity }
|
{ verbosity }
|
||||||
v_none = $0;
|
v_none = $0;
|
||||||
@ -281,16 +281,21 @@ begin
|
|||||||
has_more_infos:=true;
|
has_more_infos:=true;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure SetHasErrors;
|
||||||
|
begin
|
||||||
|
has_errors:=true;
|
||||||
|
end;
|
||||||
|
|
||||||
Procedure WriteError(const S : string);
|
Procedure WriteError(const S : string);
|
||||||
Begin
|
Begin
|
||||||
Writeln(S);
|
Writeln(S);
|
||||||
has_errors:=true;
|
SetHasErrors;
|
||||||
End;
|
End;
|
||||||
|
|
||||||
function Unknown(const st : string; val :longint) : string;
|
function Unknown(const st : string; val :longint) : string;
|
||||||
Begin
|
Begin
|
||||||
Unknown:='<!! Unknown'+st+' value '+tostr(val)+'>';
|
Unknown:='<!! Unknown'+st+' value '+tostr(val)+'>';
|
||||||
has_errors:=true;
|
SetHasErrors;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function ToStr(w:longint):String;
|
function ToStr(w:longint):String;
|
||||||
@ -439,7 +444,7 @@ begin
|
|||||||
if ntflags<>0 then
|
if ntflags<>0 then
|
||||||
begin
|
begin
|
||||||
s:=s+' unknown '+hexstr(ntflags,8);
|
s:=s+' unknown '+hexstr(ntflags,8);
|
||||||
has_errors:=true;
|
SetHasErrors;
|
||||||
end;
|
end;
|
||||||
PPUFlags2Str:=s;
|
PPUFlags2Str:=s;
|
||||||
end;
|
end;
|
||||||
@ -473,7 +478,7 @@ end;
|
|||||||
if t=-1 then
|
if t=-1 then
|
||||||
begin
|
begin
|
||||||
Result := 'Not Found';
|
Result := 'Not Found';
|
||||||
has_errors:=true;
|
SetHasErrors;
|
||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
DT := FileDateToDateTime(t);
|
DT := FileDateToDateTime(t);
|
||||||
@ -493,7 +498,7 @@ var
|
|||||||
begin
|
begin
|
||||||
if ppufile.readentry<>ibrecsymtableoptions then
|
if ppufile.readentry<>ibrecsymtableoptions then
|
||||||
begin
|
begin
|
||||||
has_errors:=true;
|
SetHasErrors;
|
||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
writeln(space,' recordalignment: ',shortint(ppufile.getbyte));
|
writeln(space,' recordalignment: ',shortint(ppufile.getbyte));
|
||||||
@ -522,7 +527,7 @@ var
|
|||||||
begin
|
begin
|
||||||
if ppufile.readentry<>ibsymtableoptions then
|
if ppufile.readentry<>ibsymtableoptions then
|
||||||
begin
|
begin
|
||||||
has_errors:=true;
|
SetHasErrors;
|
||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
ppufile.getsmallset(options);
|
ppufile.getsmallset(options);
|
||||||
@ -744,7 +749,7 @@ begin
|
|||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
bindstr:='<Error !!>';
|
bindstr:='<Error !!>';
|
||||||
has_errors:=true;
|
SetHasErrors;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
case tasmsymtype(ppufile.getbyte) of
|
case tasmsymtype(ppufile.getbyte) of
|
||||||
@ -761,7 +766,7 @@ begin
|
|||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
typestr:='<Error !!>';
|
typestr:='<Error !!>';
|
||||||
has_errors:=true;
|
SetHasErrors;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
Writeln(space,' ',i,' : ',s,' [',bindstr,',',typestr,']');
|
Writeln(space,' ',i,' : ',s,' [',bindstr,',',typestr,']');
|
||||||
@ -829,7 +834,7 @@ begin
|
|||||||
if (idx>derefdatalen) then
|
if (idx>derefdatalen) then
|
||||||
begin
|
begin
|
||||||
writeln('!! Error: Deref idx ',idx,' > ',derefdatalen);
|
writeln('!! Error: Deref idx ',idx,' > ',derefdatalen);
|
||||||
has_errors:=true;
|
SetHasErrors;
|
||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
write(derefspace,'(',idx,') ');
|
write(derefspace,'(',idx,') ');
|
||||||
@ -874,7 +879,7 @@ begin
|
|||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
writeln('!! unsupported dereftyp: ',ord(b));
|
writeln('!! unsupported dereftyp: ',ord(b));
|
||||||
has_errors:=true;
|
SetHasErrors;
|
||||||
break;
|
break;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
@ -1835,7 +1840,7 @@ begin
|
|||||||
begin
|
begin
|
||||||
writeln('!! ibcreatedobjtypes entry not found');
|
writeln('!! ibcreatedobjtypes entry not found');
|
||||||
ppufile.skipdata(ppufile.entrysize);
|
ppufile.skipdata(ppufile.entrysize);
|
||||||
has_errors:=true;
|
SetHasErrors;
|
||||||
exit
|
exit
|
||||||
end;
|
end;
|
||||||
writeln;
|
writeln;
|
||||||
@ -1996,6 +2001,8 @@ begin
|
|||||||
end;
|
end;
|
||||||
constreal :
|
constreal :
|
||||||
begin
|
begin
|
||||||
|
write (space,' RealType : ');
|
||||||
|
readderef('');
|
||||||
write(space,' Value : ');
|
write(space,' Value : ');
|
||||||
if entryleft=sizeof(ppureal) then
|
if entryleft=sizeof(ppureal) then
|
||||||
begin
|
begin
|
||||||
@ -2021,7 +2028,7 @@ begin
|
|||||||
begin
|
begin
|
||||||
realvalue:=0.0;
|
realvalue:=0.0;
|
||||||
writeln(realvalue,' Error reading real value');
|
writeln(realvalue,' Error reading real value');
|
||||||
has_errors:=true;
|
SetHasErrors;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
constset :
|
constset :
|
||||||
@ -2238,7 +2245,7 @@ begin
|
|||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
WriteLn('!! Skipping unsupported PPU Entry in Symbols: ',b);
|
WriteLn('!! Skipping unsupported PPU Entry in Symbols: ',b);
|
||||||
has_errors:=true;
|
SetHasErrors;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
if not EndOfEntry then
|
if not EndOfEntry then
|
||||||
@ -2664,7 +2671,7 @@ begin
|
|||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
WriteLn('!! Skipping unsupported PPU Entry in definitions: ',b);
|
WriteLn('!! Skipping unsupported PPU Entry in definitions: ',b);
|
||||||
has_errors:=true;
|
SetHasErrors;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
if not EndOfEntry then
|
if not EndOfEntry then
|
||||||
@ -2826,7 +2833,7 @@ begin
|
|||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
WriteLn('!! Skipping unsupported PPU Entry in General Part: ',b);
|
WriteLn('!! Skipping unsupported PPU Entry in General Part: ',b);
|
||||||
has_errors:=true;
|
SetHasErrors;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
until false;
|
until false;
|
||||||
@ -2864,7 +2871,7 @@ begin
|
|||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
WriteLn('!! Skipping unsupported PPU Entry in Implementation: ',b);
|
WriteLn('!! Skipping unsupported PPU Entry in Implementation: ',b);
|
||||||
has_errors:=true;
|
SetHasErrors;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
until false;
|
until false;
|
||||||
@ -2889,7 +2896,7 @@ begin
|
|||||||
if not ppufile.CheckPPUID then
|
if not ppufile.CheckPPUID then
|
||||||
begin
|
begin
|
||||||
writeln(Filename,' : Not a valid PPU file, Skipping');
|
writeln(Filename,' : Not a valid PPU file, Skipping');
|
||||||
has_errors:=true;
|
SetHasErrors;
|
||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
{ Check PPU Version }
|
{ Check PPU Version }
|
||||||
@ -2899,7 +2906,7 @@ begin
|
|||||||
if PPUVersion<16 then
|
if PPUVersion<16 then
|
||||||
begin
|
begin
|
||||||
writeln(Filename,' : Old PPU Formats (<v16) are not supported, Skipping');
|
writeln(Filename,' : Old PPU Formats (<v16) are not supported, Skipping');
|
||||||
has_errors:=true;
|
SetHasErrors;
|
||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
{ Write PPU Header Information }
|
{ Write PPU Header Information }
|
||||||
|
Loading…
Reference in New Issue
Block a user