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

* support new readtype

Browse Source
This commit is contained in:
peter 1999-11-30 10:35:36 +00:00
parent 1eb4bfc435
commit 6cd0c0425a
2 changed files with 112 additions and 87 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
utils/ppu.pas
View File

@ -45,9 +45,9 @@ const
{$endif ORDERSOURCES} {$endif ORDERSOURCES}
{$else newcg} {$else newcg}
{$ifdef ORDERSOURCES} {$ifdef ORDERSOURCES}
CurrentPPUVersion=18; CurrentPPUVersion=19;
{$else ORDERSOURCES} {$else ORDERSOURCES}
CurrentPPUVersion=17; CurrentPPUVersion=18;
{$endif ORDERSOURCES} {$endif ORDERSOURCES}
{$endif newcg} {$endif newcg}
@ -994,8 +994,11 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.7 1999-11-23 09:44:15 peter Revision 1.8 1999-11-30 10:35:36 peter
* updated * support new readtype
Revision 1.51 1999/11/23 09:42:38 peter
* makefile updates to work with new fpcmake
Revision 1.50 1999/11/21 01:42:37 pierre Revision 1.50 1999/11/21 01:42:37 pierre
* Nextoverloading ordering fix * Nextoverloading ordering fix

188
utils/ppudump.pp
View File

@ -47,8 +47,6 @@ const
var var
ppufile : pppufile; ppufile : pppufile;
space : string; space : string;
symcnt,
defcnt : longint;
read_member : boolean; read_member : boolean;
verbose : longint; verbose : longint;
@ -226,7 +224,7 @@ begin
end; end;
function readderef(const s:string):boolean; function readderef(const s:string;skipnil:boolean):boolean;
type type
tdereftype = (derefnil,derefaktrecordindex,derefaktstaticindex,derefunit, tdereftype = (derefnil,derefaktrecordindex,derefaktstaticindex,derefunit,
derefrecord,derefindex,dereflocal,derefpara); derefrecord,derefindex,dereflocal,derefpara);
@ -239,7 +237,8 @@ begin
case b of case b of
derefnil : derefnil :
begin begin
writeln('nil'); if not skipnil then
writeln('nil');
readderef:=false; readderef:=false;
break; break;
end; end;
@ -281,13 +280,38 @@ end;
function readdefref:boolean; function readdefref:boolean;
begin begin
readdefref:=readderef('Definition'); readdefref:=readderef('Definition',false);
end; end;
function readsymref:boolean; function readsymref:boolean;
begin begin
readsymref:=readderef('Symbol'); readsymref:=readderef('Symbol',false);
end;
procedure readtype;
var
b1,b2 : boolean;
begin
b1:=readderef('Definition',true);
b2:=readderef('Symbol',true);
if not(b1 or b2) then
Writeln('nil')
else
if (b1 and b2) then
Writeln('!! Type has both definition and symbol stored');
end;
procedure readsymlist(const s:string);
begin
readdefref;
repeat
write(s);
if not readsymref then
break;
until false;
end; end;
@ -401,7 +425,7 @@ var
first : boolean; first : boolean;
begin begin
write(space,' Return type : '); write(space,' Return type : ');
readdefref; readtype;
writeln(space,' Fpu used : ',ppufile^.getbyte); writeln(space,' Fpu used : ',ppufile^.getbyte);
proctypeoption:=tproctypeoption(ppufile^.getlongint); proctypeoption:=tproctypeoption(ppufile^.getlongint);
if proctypeoption<>potype_none then if proctypeoption<>potype_none then
@ -456,11 +480,8 @@ begin
if params>0 then if params>0 then
begin begin
repeat repeat
writeln(space,' - ',tvarspez[ppufile^.getbyte]); write(space,' - ',tvarspez[ppufile^.getbyte],' : ');
write (space,' def : '); readtype;
readdefref;
write (space,' defsym : ');
readsymref;
dec(params); dec(params);
until params=0; until params=0;
end; end;
@ -536,26 +557,21 @@ end;
****************************************************************************} ****************************************************************************}
procedure readsymbols; procedure readsymbols;
procedure readpropsymlist;
begin
repeat
if not readsymref then
break;
write(space,' ');
until false;
end;
Const Const
vo_is_C_var = 2; vo_is_C_var = 2;
Type Type
absolutetyp = (tovar,toasm,toaddr); absolutetyp = (tovar,toasm,toaddr);
tconsttype = (constord,conststring,constreal,constbool,constint,constchar,constseta); tconsttyp = (constnone,
constord,conststring,constreal,constbool,
constint,constchar,constset,constpointer,constnil,
constresourcestring
);
var var
b : byte; b : byte;
pc : pchar;
totalsyms, totalsyms,
symcnt, symcnt,
i,j : longint; i,j,len : longint;
begin begin
symcnt:=1; symcnt:=1;
with ppufile^ do with ppufile^ do
@ -588,8 +604,8 @@ begin
ibtypesym : ibtypesym :
begin begin
readcommonsym('Type symbol '); readcommonsym('Type symbol ');
write(space,' Definition: '); write(space,' Result Type: ');
readdefref; readtype;
end; end;
ibprocsym : ibprocsym :
@ -603,15 +619,31 @@ begin
begin begin
readcommonsym('Constant symbol '); readcommonsym('Constant symbol ');
b:=getbyte; b:=getbyte;
case tconsttype(b) of case tconsttyp(b) of
constord : constord :
begin begin
write (space,' Definition : '); write (space,' Ordinal Type : ');
readdefref; readtype;
writeln (space,' Value : ',getlongint) writeln (space,' Value : ',getlongint)
end;
constpointer :
begin
write (space,' Pointer Type : ');
readtype;
writeln (space,' Value : ',getlongint)
end;
conststring,
constresourcestring :
begin
len:=getlongint;
getmem(pc,len+1);
getdata(pc^,len);
writeln(space,' Length : ',len);
writeln(space,' Value : "',pc,'"');
freemem(pc,len+1);
if tconsttyp(b)=constresourcestring then
writeln(space,' Index : ',getlongint);
end; end;
conststring :
writeln(space,' Value : "'+getstring+'"');
constreal : constreal :
writeln(space,' Value : ',getreal); writeln(space,' Value : ',getreal);
constbool : constbool :
@ -623,10 +655,10 @@ begin
writeln(space,' Value : ',getlongint); writeln(space,' Value : ',getlongint);
constchar : constchar :
writeln(space,' Value : "'+chr(getlongint)+'"'); writeln(space,' Value : "'+chr(getlongint)+'"');
constseta : constset :
begin begin
write (space,' Definition : '); write (space,' Set Type : ');
readdefref; readtype;
for i:=1to 4 do for i:=1to 4 do
begin begin
write (space,' Value : '); write (space,' Value : ');
@ -650,10 +682,8 @@ begin
writeln(space,' Type: ',getbyte); writeln(space,' Type: ',getbyte);
if read_member then if read_member then
writeln(space,' Address: ',getlongint); writeln(space,' Address: ',getlongint);
write (space,' Definition: '); write (space,' Var Type: ');
readdefref; readtype;
write (space,' DefinitionSym: ');
readsymref;
i:=getlongint; i:=getlongint;
writeln(space,' Options: ',i); writeln(space,' Options: ',i);
if (i and vo_is_C_var)<>0 then if (i and vo_is_C_var)<>0 then
@ -677,10 +707,8 @@ begin
ibtypedconstsym : ibtypedconstsym :
begin begin
readcommonsym('Typed constant '); readcommonsym('Typed constant ');
write (space,' Definition: '); write (space,' Constant Type: ');
readdefref; readtype;
write (space,' DefinitionSym: ');
readsymref;
writeln(space,' Label: ',getstring); writeln(space,' Label: ',getstring);
writeln(space,' ReallyConst: ',(getbyte<>0)); writeln(space,' ReallyConst: ',(getbyte<>0));
end; end;
@ -691,11 +719,9 @@ begin
writeln(space,' Type: ',getbyte); writeln(space,' Type: ',getbyte);
if read_member then if read_member then
writeln(space,' Address: ',getlongint); writeln(space,' Address: ',getlongint);
write (space,' Definition: '); write (space,' Var Type: ');
readdefref; readtype;
write (space,' DefinitionSym: '); writeln(space,' Options: ',getlongint);
readsymref;
writeln(space,' Options: ',getbyte);
Write (space,' Relocated to '); Write (space,' Relocated to ');
b:=getbyte; b:=getbyte;
case absolutetyp(b) of case absolutetyp(b) of
@ -716,33 +742,27 @@ begin
ibpropertysym : ibpropertysym :
begin begin
readcommonsym('Property '); readcommonsym('Property ');
write (space,' Definition: '); write (space,' Prop Type: ');
readdefref; readtype;
writeln(space,' Options: ',getlongint); writeln(space,' Options: ',getlongint);
writeln(space,' Index: ',getlongint); writeln(space,' Index: ',getlongint);
writeln(space,' Default: ',getlongint); writeln(space,' Default: ',getlongint);
write (space,' Read symbol: '); write (space,' Index Type: ');
readpropsymlist; readtype;
write (space,' Write symbol: '); write (space,' Read access: ');
readpropsymlist; readsymlist(space+' Sym: ');
write (space,' Stored symbol: '); write (space,' Write access: ');
readpropsymlist; readsymlist(space+' Sym: ');
write (space,' Read Definition: '); write (space,' Stored access: ');
readdefref; readsymlist(space+' Sym: ');
write (space,' Write Definition: ');
readdefref;
write (space,' Stored Definition: ');
readdefref;
write (space,' Index Definition: ');
readdefref;
end; end;
ibfuncretsym : ibfuncretsym :
begin begin
readcommonsym('Func return value '); readcommonsym('Func return value ');
write (space,' Definition: '); write (space,' Return Type: ');
readdefref; readtype;
writeln(space,' Address: ',getlongint); writeln(space,' Address: ',getlongint);
end; end;
iberror : iberror :
@ -809,9 +829,9 @@ begin
ibpointerdef : ibpointerdef :
begin begin
readcommondef('Pointer definition'); readcommondef('Pointer definition');
write (space,' To Definition : '); write (space,' Pointed Type : ');
readdefref; readtype;
writeln(space,' Is Far : ',(getbyte<>0)); writeln(space,' Is Far : ',(getbyte<>0));
end; end;
iborddef : iborddef :
@ -849,9 +869,9 @@ begin
begin begin
readcommondef('Array definition'); readcommondef('Array definition');
write (space,' Element type : '); write (space,' Element type : ');
readdefref; readtype;
write (space,' Range Type : '); write (space,' Range Type : ');
readdefref; readtype;
writeln(space,' Range : ',getlongint,' to ',getlongint); writeln(space,' Range : ',getlongint,' to ',getlongint);
writeln(space,' Is Constructor : ',(getbyte<>0)); writeln(space,' Is Constructor : ',(getbyte<>0));
end; end;
@ -941,8 +961,9 @@ begin
case getbyte of case getbyte of
0 : writeln('Text'); 0 : writeln('Text');
1 : begin 1 : begin
write('Typed with definition '); writeln('Typed');
readdefref; write (space,' File of Type : ');
Readtype;
end; end;
2 : writeln('Untyped'); 2 : writeln('Untyped');
end; end;
@ -964,15 +985,15 @@ begin
ibclassrefdef : ibclassrefdef :
begin begin
readcommondef('Class reference definition'); readcommondef('Class reference definition');
write (space,' To definition : '); write (space,' Pointed Type : ');
readdefref; readtype;
end; end;
ibsetdef : ibsetdef :
begin begin
readcommondef('Set definition'); readcommondef('Set definition');
write (space,' Element type : '); write (space,' Element type : ');
readdefref; readtype;
b:=getbyte; b:=getbyte;
case tsettype(b) of case tsettype(b) of
smallset : writeln(space,' Set with 32 Elements'); smallset : writeln(space,' Set with 32 Elements');
@ -1207,8 +1228,6 @@ var
begin begin
{ reset } { reset }
space:=''; space:='';
defcnt:=0;
symcnt:=0;
{ fix filename } { fix filename }
if pos('.',filename)=0 then if pos('.',filename)=0 then
filename:=filename+'.ppu'; filename:=filename+'.ppu';
@ -1423,7 +1442,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.10 1999-11-08 14:06:45 florian Revision 1.11 1999-11-30 10:35:37 peter
* support new readtype
Revision 1.10 1999/11/08 14:06:45 florian
+ indexref of propertysym is handle too now + indexref of propertysym is handle too now
Revision 1.9 1999/08/31 16:07:37 pierre Revision 1.9 1999/08/31 16:07:37 pierre