{ DUMPPPU.PAS }
{ Copyright (c) 1995,96 by FP Klämpfl }
{ History:
Januar 1995: Version 0.1
3.3.1995: Version 0.15
PPU-Format 8 wird unterstützt
Prozeduroptionen werden aufgeschlüsselt angezeigt
14.3.1995: Version 0.16
Prozeduroption iocheck hinzugefügt
31.3.1995: Version 0.2
space vor alle write eingefügt
tclassdef wird eingelesen und angezeigt
31.3.1995: Version 0.25
Aufzähltypen werden angezeigt
31.3.1995: Version 0.49
Mengen werden angezeigt
24.12.1995: Version 0.5
PPU-Format 9 wird unterstützt
Rechtschreibfehler beseitigt
6.3.1995: Version 0.5.10
PPU-Format 10 wird unterstützt
}
{$N+,E+,G+}
program dumpppu;
var
f : file;
version : word;
const
ibloadunit = 1;
ibgrunddef = 2;
ibpointerdef = 3;
ibtypesym = 4;
ibarraydef = 5;
ibprocdef = 6;
ibprocsym = 7;
iblinkofile = 8;
ibstringdef = 9;
ibvarsym = 10;
ibconstsym = 11;
ibinitunit = 12;
ibaufzaehlsym = 13;
ibtypedconstsym = 14;
ibrecorddef = 15;
ibfiledef = 16;
ibformaldef = 17;
ibclassdef = 18;
ibaufzaehldef = 19;
ibsetdef = 20;
ibprocvardef = 21;
ibend = 255;
function readlong : longint;
var
l : longint;
begin
blockread(f,l,4);
readlong:=l;
end;
function readword : word;
var
w : word;
begin
blockread(f,w,2);
readword:=w;
end;
function readdouble : double;
var
d : double;
begin
blockread(f,d,8);
readdouble:=d;
end;
function readbyte : byte;
var
b : byte;
begin
blockread(f,b,1);
readbyte:=b;
end;
function readstring : string;
var
s : string;
begin
s[0]:=chr(readbyte);
blockread(f,s[1],ord(s[0]));
readstring:=s;
end;
var
space : string;
read_member : boolean;
procedure readandwriteref;
var
w : word;
begin
w:=readword;
if w=$ffff then
begin
w:=readword;
if w=$ffff then
writeln('nil')
else writeln('Lokale Definition Nr. ',w)
end
else writeln('Unit ',w,' Nr.',readword)
end;
var
b : byte;
unitnumber : word;
type
tsettyp = (normset);
procedure readin;
var
oldread_member : boolean;
counter : word;
procedure read_abstract_proc_def;
var
params : word;
options : word;
begin
write(space,' Rückgabetype: ');
readandwriteref;
options:=readword;
if options<>0 then
begin
writeln(space,' Optionen: ');
if (options and 1)<>0 then
writeln(space,' Ausnahmebehandlung');
if (options and 2)<>0 then
writeln(space,' virtuelle Methode');
if (options and 4)<>0 then
writeln(space,' Parameter werden nicht vom Stack entfernt');
if (options and 8)<>0 then
writeln(space,' Konstruktor');
if (options and $10)<>0 then
writeln(space,' Destruktor');
if (options and $20)<>0 then
writeln(space,' Interne Prozedur');
if (options and $40)<>0 then
writeln(space,' Unterprogramm wird exportiert (EXPORT)');
if (options and $80)<>0 then
writeln(space,' I/O-Überprüfung');
end;
params:=readword;
writeln(space,' Parameteranzahl: ',params);
writeln(space,' Parameter: ');
while params>0 do
begin
write(space,' Typ: ',readbyte,' ');
readandwriteref;
dec(params);
end;
end;
var
params : word;
begin
counter:=0;
repeat
b:=readbyte;
if (b<>ibend) and (b<>ibloadunit) and (b<>ibinitunit) and (b<>iblinkofile) then
begin
write(space,'Definition Nr.',counter,': ');
inc(counter);
end;
case b of
ibloadunit : begin
writeln('Abhängig von: ',readstring,' (',unitnumber,
') Gespeicherte Kontrollnummer: ',readlong);
inc(unitnumber);
end;
ibpointerdef : begin
write(space,'Zeigerdefinition auf ');
readandwriteref;
end;
ibgrunddef : begin
write(space,'Grundtyp ');
case readbyte of
0 : writeln('uauto');
1 : writeln('u8bit');
2 : writeln('s32bit');
3 : writeln('s64real');
4 : writeln('uvoid');
5 : writeln('bool8bit');
6 : writeln('uchar');
7 : writeln('s8bit');
8 : writeln('s16bit');
9 : writeln('u16bit');
end;
writeln(space,' Bereich: ',readlong,' bis ',readlong);
end;
ibarraydef : begin
writeln(space,'Arraydefinition');
write(space,' Elementtyp: ');
readandwriteref;
write(space,' Bereichstyp: ');
readandwriteref;
writeln(space,' Bereich: ',readlong,' bis ',readlong);
end;
ibprocdef : begin
writeln(space,'Unterprogrammdefinition');
if version<8 then
begin
writeln(space,' Benutzte Register: ',readbyte);
write(space,' Rückgabetype: ');
readandwriteref;
writeln(space,' Optionen: ',readword);
writeln(space,' Umgesetzter Name: ',readstring);
writeln(space,' Nummer: ',readlong);
write(space,' Nächstes: ');
readandwriteref;
params:=readword;
writeln(space,' Parameteranzahl: ',params);
writeln(space,' Parameter: ');
while params>0 do
begin
write(space,' Typ: ',readbyte,' ');
readandwriteref;
dec(params);
end;
end
else
begin
read_abstract_proc_def;
writeln(space,' Benutzte Register: ',readbyte);
writeln(space,' Umgesetzter Name: ',readstring);
writeln(space,' Nummer: ',readlong);
write(space,' Nächstes: ');
readandwriteref;
end;
end;
ibprocvardef : begin
writeln(space,'Prozedurvariablentyp');
read_abstract_proc_def;
end;
ibstringdef : writeln(space,'Stringdefinition der Länge ',readbyte);
ibrecorddef : begin
writeln(space,'Recorddefinition der Größe ',readlong);
oldread_member:=read_member;
read_member:=true;
space:=space+' ';
readin;
dec(byte(space[0]),4);
read_member:=oldread_member;
end;
ibclassdef : begin
writeln(space,'Klassendefinition der Größe ',readlong);
writeln(space,' Name der Klasse: ',readstring);
write(space,' Superklasse: ');
readandwriteref;
oldread_member:=read_member;
read_member:=true;
space:=space+' ';
readin;
dec(byte(space[0]),4);
read_member:=oldread_member;
end;
ibfiledef : begin
case readbyte of
0 : writeln(space,'Textdateidefinition');
1 : begin
write(space,'Typisierte Datei vom Typ ');
readandwriteref;
end;
2 : writeln(space,'Untypsierte Dateidefinition');
end;
end;
ibformaldef : writeln(space,'Generische Definition (void-typ)');
ibaufzaehldef : begin
writeln(space,'Aufzähldefinition');
writeln(space,' Größtes Element: ',readlong);
end;
ibinitunit : writeln('Initialisiere: ',readstring);
iblinkofile : writeln('Linke mit: ',readstring);
ibsetdef : begin
writeln(space,'Mengendefinition');
write(space,' Elementtyp: ');
readandwriteref;
b:=readbyte;
case tsettyp(b) of
normset : writeln(space,' Menge mit 256 Elementen');
else
begin
writeln('Ungültiges Unitformat');
halt(1);
end;
end;
end;
ibend : break;
else
begin
writeln('Ungültiges Unitformat');
halt(1);
end;
end;
until false;
repeat
b:=readbyte;
case b of
ibtypesym : begin
writeln(space,'Typsymbol ',readstring);
write(space,' Definition: ');
readandwriteref;
end;
ibprocsym : begin
writeln(space,'Unterprogrammsymbol ',readstring);
write(space,' Definition: ');
readandwriteref;
end;
ibconstsym : begin
if version<10 then
begin
writeln(space,'Konstantensymbol ',readstring);
write(space,' Wert: ');
case readbyte of
0 : writeln(readlong);
1 : writeln('"'+readstring+'"');
2 : writeln(''''+chr(readbyte)+'''');
3 : writeln(readdouble);
4 : if readbyte=0 then writeln('FALSE')
else writeln('TRUE');
end;
end
else
begin
writeln(space,'Konstantensymbol ',readstring);
write(space,' Definition: ');
b:=readbyte;
readandwriteref;
write(space,' Wert: ');
case b of
0 : writeln(readlong);
1 : writeln('"'+readstring+'"');
2 : writeln(readdouble);
end;
end;
end;
ibvarsym : begin
writeln(space,'Variablensymbol ',readstring);
writeln(space,' Typ: ',readbyte);
if read_member then
writeln(space,' Adresse: ',readlong);
write(space,' Definition: ');
readandwriteref;
end;
ibaufzaehlsym : begin
writeln(space,'Aufzählsymbol ',readstring);
write(space,' Definition: ');
readandwriteref;
writeln(space,' Wert: ',readlong);
end;
ibtypedconstsym : begin
writeln(space,'Typisierte Konstanten ',readstring);
write(space,' Definition');
readandwriteref;
writeln(space,' Label: ',readstring);
end;
ibend : break;
else
begin
writeln('Ungültiges Unitformat');
halt(1);
end;
end;
until false;
end;
var
hs : string;
w : word;
begin
writeln('PPU-Anzeiger Version 0.5.10 Copyright (c) 1995,96 by FP Klämpfl');
writeln;
if paramcount<>1 then
begin
writeln('DUMPPPU <Datei>');
halt(1);
end;
assign(f,paramstr(1));
reset(f,1);
if (readbyte<>ord('P')) or
(readbyte<>ord('P')) or
(readbyte<>ord('U')) then
begin
writeln('Keine gültige PPU-Datei');
halt(1);
end;
hs:=chr(readbyte)+chr(readbyte)+chr(readbyte);
val(hs,version,w);
writeln('PPU-Format: ',version);
writeln('Compilerversion: ',readbyte,'.',readbyte);
write('Zielbetriebssystem: ');
case readbyte of
0 : write('DOS');
1 : write('OS/2');
2 : write('Linux');
3 : write('Win32');
end;
readbyte;
writeln;
writeln('Kontrollnummer: ',readlong);
readword;
if version>=9 then
writeln('Objektcodestart: ',readlong);
unitnumber:=1;
space:='';
read_member:=false;
readin;
close(f);
end.
