mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 13:09:32 +02:00
* updates for new options
This commit is contained in:
peter
parent
8d9aa81d3a
commit
30679bdff4
@ -37,7 +37,11 @@ type
|
||||
{$endif Test_Double_checksum}
|
||||
|
||||
const
|
||||
{$ifdef newcg}
|
||||
CurrentPPUVersion=100;
|
||||
{$else newcg}
|
||||
CurrentPPUVersion=17;
|
||||
{$endif newcg}
|
||||
|
||||
{ buffer sizes }
|
||||
maxentrysize = 1024;
|
||||
@ -204,6 +208,8 @@ type
|
||||
function getlongint:longint;
|
||||
function getreal:ppureal;
|
||||
function getstring:string;
|
||||
procedure getnormalset(var b);
|
||||
procedure getsmallset(var b);
|
||||
function skipuntilentry(untilb:byte):boolean;
|
||||
{write}
|
||||
function create:boolean;
|
||||
@ -217,6 +223,8 @@ type
|
||||
procedure putlongint(l:longint);
|
||||
procedure putreal(d:ppureal);
|
||||
procedure putstring(s:string);
|
||||
procedure putnormalset(var b);
|
||||
procedure putsmallset(var b);
|
||||
end;
|
||||
|
||||
implementation
|
||||
@ -652,6 +660,18 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure tppufile.getsmallset(var b);
|
||||
begin
|
||||
getdata(b,4);
|
||||
end;
|
||||
|
||||
|
||||
procedure tppufile.getnormalset(var b);
|
||||
begin
|
||||
getdata(b,32);
|
||||
end;
|
||||
|
||||
|
||||
function tppufile.skipuntilentry(untilb:byte):boolean;
|
||||
var
|
||||
b : byte;
|
||||
@ -868,11 +888,26 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure tppufile.putsmallset(var b);
|
||||
begin
|
||||
putdata(b,4);
|
||||
end;
|
||||
|
||||
|
||||
procedure tppufile.putnormalset(var b);
|
||||
begin
|
||||
putdata(b,32);
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 1999-07-27 23:46:55 peter
|
||||
* version 17 ppu
|
||||
Revision 1.4 1999-08-15 10:47:12 peter
|
||||
* updates for new options
|
||||
|
||||
Revision 1.37 1999/08/02 23:13:20 florian
|
||||
* more changes to compile for the Alpha
|
||||
|
||||
Revision 1.36 1999/07/23 16:05:25 peter
|
||||
* alignment is now saved in the symtable
|
||||
|
||||
235
utils/ppudump.pp
235
utils/ppudump.pp
@ -222,18 +222,20 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure readderef(const s:string);
|
||||
function readderef(const s:string):boolean;
|
||||
type
|
||||
tdereftype = (derefnil,derefaktrecordindex,derefaktstaticindex,derefunit,derefrecord,derefindex);
|
||||
var
|
||||
b : tdereftype;
|
||||
begin
|
||||
readderef:=true;
|
||||
repeat
|
||||
b:=tdereftype(ppufile^.getbyte);
|
||||
case b of
|
||||
derefnil :
|
||||
begin
|
||||
writeln('nil');
|
||||
readderef:=false;
|
||||
break;
|
||||
end;
|
||||
derefaktrecordindex :
|
||||
@ -264,68 +266,169 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure readdefref;
|
||||
function readdefref:boolean;
|
||||
begin
|
||||
readderef('Definition');
|
||||
readdefref:=readderef('Definition');
|
||||
end;
|
||||
|
||||
|
||||
procedure readsymref;
|
||||
function readsymref:boolean;
|
||||
begin
|
||||
readderef('Symbol');
|
||||
readsymref:=readderef('Symbol');
|
||||
end;
|
||||
|
||||
|
||||
procedure read_abstract_proc_def;
|
||||
type
|
||||
tproccalloption=(pocall_none,
|
||||
pocall_clearstack, { Use IBM flat calling convention. (Used by GCC.) }
|
||||
pocall_leftright, { Push parameters from left to right }
|
||||
pocall_cdecl, { procedure uses C styled calling }
|
||||
pocall_register, { procedure uses register (fastcall) calling }
|
||||
pocall_stdcall, { procedure uses stdcall call }
|
||||
pocall_safecall, { safe call calling conventions }
|
||||
pocall_palmossyscall, { procedure is a PalmOS system call }
|
||||
pocall_system,
|
||||
pocall_inline, { Procedure is an assembler macro }
|
||||
pocall_internproc, { Procedure has compiler magic}
|
||||
pocall_internconst { procedure has constant evaluator intern }
|
||||
);
|
||||
tproccalloptions=set of tproccalloption;
|
||||
tproctypeoption=(potype_none,
|
||||
potype_proginit, { Program initialization }
|
||||
potype_unitinit, { unit initialization }
|
||||
potype_unitfinalize, { unit finalization }
|
||||
potype_constructor, { Procedure is a constructor }
|
||||
potype_destructor, { Procedure is a destructor }
|
||||
potype_operator { Procedure defines an operator }
|
||||
);
|
||||
tproctypeoptions=set of tproctypeoption;
|
||||
tprocoption=(po_none,
|
||||
po_classmethod, { class method }
|
||||
po_virtualmethod, { Procedure is a virtual method }
|
||||
po_abstractmethod, { Procedure is an abstract method }
|
||||
po_staticmethod, { static method }
|
||||
po_overridingmethod, { method with override directive }
|
||||
po_methodpointer, { method pointer, only in procvardef, also used for 'with object do' }
|
||||
po_containsself, { self is passed explicit to the compiler }
|
||||
po_interrupt, { Procedure is an interrupt handler }
|
||||
po_iocheck, { IO checking should be done after a call to the procedure }
|
||||
po_assembler, { Procedure is written in assembler }
|
||||
po_msgstr, { method for string message handling }
|
||||
po_msgint, { method for int message handling }
|
||||
po_exports, { Procedure has export directive (needed for OS/2) }
|
||||
po_external, { Procedure is external (in other object or lib)}
|
||||
po_savestdregs, { save std regs cdecl and stdcall need that ! }
|
||||
po_saveregisters { save all registers }
|
||||
);
|
||||
tprocoptions=set of tprocoption;
|
||||
type
|
||||
tproccallopt=record
|
||||
mask : tproccalloption;
|
||||
str : string[30];
|
||||
end;
|
||||
tproctypeopt=record
|
||||
mask : tproctypeoption;
|
||||
str : string[30];
|
||||
end;
|
||||
tprocopt=record
|
||||
mask : longint;
|
||||
mask : tprocoption;
|
||||
str : string[30];
|
||||
end;
|
||||
const
|
||||
procopts=24;
|
||||
proccallopts=12;
|
||||
proccallopt : array[1..proccallopts] of tproccallopt=(
|
||||
(mask:pocall_none; str:''),
|
||||
(mask:pocall_clearstack; str:'ClearStack'),
|
||||
(mask:pocall_leftright; str:'LeftRight'),
|
||||
(mask:pocall_cdecl; str:'Cdecl'),
|
||||
(mask:pocall_register; str:'Register'),
|
||||
(mask:pocall_stdcall; str:'StdCall'),
|
||||
(mask:pocall_safecall; str:'SafeCall'),
|
||||
(mask:pocall_palmossyscall;str:'PalmOSSysCall'),
|
||||
(mask:pocall_system; str:'System'),
|
||||
(mask:pocall_inline; str:'Inline'),
|
||||
(mask:pocall_internproc; str:'InternProc'),
|
||||
(mask:pocall_internconst; str:'InternConst')
|
||||
);
|
||||
proctypeopts=6;
|
||||
proctypeopt : array[1..proctypeopts] of tproctypeopt=(
|
||||
(mask:potype_proginit; str:'ProgInit'),
|
||||
(mask:potype_unitinit; str:'UnitInit'),
|
||||
(mask:potype_unitfinalize;str:'UnitFinalize'),
|
||||
(mask:potype_constructor; str:'Constructor'),
|
||||
(mask:potype_destructor; str:'Destructor'),
|
||||
(mask:potype_operator; str:'Operator')
|
||||
);
|
||||
procopts=16;
|
||||
procopt : array[1..procopts] of tprocopt=(
|
||||
(mask:1; str:'Exception handler'),
|
||||
(mask:2; str:'Virtual Method'),
|
||||
(mask:4; str:'Stack is not cleared'),
|
||||
(mask:8; str:'Constructor'),
|
||||
(mask:$10; str:'Destructor'),
|
||||
(mask:$20; str:'Internal Procedure'),
|
||||
(mask:$40; str:'Exported Procedure'),
|
||||
(mask:$80; str:'I/O-Checking'),
|
||||
(mask:$100; str:'Abstract method'),
|
||||
(mask:$200; str:'Interrupt Handler'),
|
||||
(mask:$400; str:'Inline Procedure'),
|
||||
(mask:$800; str:'Assembler Procedure'),
|
||||
(mask:$1000; str:'Overloaded Operator'),
|
||||
(mask:$2000; str:'External Procedure'),
|
||||
(mask:$4000; str:'Parameters from left to right'),
|
||||
(mask:$8000; str:'Main Program'),
|
||||
(mask:$10000; str:'Static Method'),
|
||||
(mask:$20000; str:'Method with Override Directive'),
|
||||
(mask:$40000; str:'Class Method'),
|
||||
(mask:$80000; str:'Unit Initialisation'),
|
||||
(mask:$100000; str:'Method Pointer'),
|
||||
(mask:$200000; str:'C Declaration'),
|
||||
(mask:$400000; str:'PalmOS Syscall'),
|
||||
(mask:$800000; str:'Has internal Constant Function')
|
||||
(mask:po_classmethod; str:'ClassMethod'),
|
||||
(mask:po_virtualmethod; str:'VirtualMethod'),
|
||||
(mask:po_abstractmethod; str:'AbstractMethod'),
|
||||
(mask:po_staticmethod; str:'StaticMethod'),
|
||||
(mask:po_overridingmethod;str:'OverridingMethod'),
|
||||
(mask:po_methodpointer; str:'MethodPointer'),
|
||||
(mask:po_containsself; str:'ContainsSelf'),
|
||||
(mask:po_interrupt; str:'Interrupt'),
|
||||
(mask:po_iocheck; str:'IOCheck'),
|
||||
(mask:po_assembler; str:'Assembler'),
|
||||
(mask:po_msgstr; str:'MsgStr'),
|
||||
(mask:po_msgint; str:'MsgInt'),
|
||||
(mask:po_exports; str:'Exports'),
|
||||
(mask:po_external; str:'External'),
|
||||
(mask:po_savestdregs; str:'SaveStdRegs'),
|
||||
(mask:po_saveregisters; str:'SaveRegisters')
|
||||
);
|
||||
tvarspez : array[0..2] of string[5]=('Value','Const','Var ');
|
||||
var
|
||||
procoptions,
|
||||
proctypeoption : tproctypeoption;
|
||||
proccalloptions : tproccalloptions;
|
||||
procoptions : tprocoptions;
|
||||
i,params : longint;
|
||||
first : boolean;
|
||||
first : boolean;
|
||||
begin
|
||||
write(space,' Return type : ');
|
||||
readdefref;
|
||||
writeln(space,' Fpu used : ',ppufile^.getbyte);
|
||||
procoptions:=ppufile^.getlongint;
|
||||
if procoptions<>0 then
|
||||
proctypeoption:=tproctypeoption(ppufile^.getlongint);
|
||||
if proctypeoption<>potype_none then
|
||||
begin
|
||||
write(space,' TypeOption : ');
|
||||
first:=true;
|
||||
for i:=1to proctypeopts do
|
||||
if (proctypeopt[i].mask=proctypeoption) then
|
||||
begin
|
||||
if first then
|
||||
first:=false
|
||||
else
|
||||
write(', ');
|
||||
write(proctypeopt[i].str);
|
||||
end;
|
||||
writeln;
|
||||
end;
|
||||
ppufile^.getsmallset(proccalloptions);
|
||||
if procoptions<>[] then
|
||||
begin
|
||||
write(space,' CallOptions : ');
|
||||
first:=true;
|
||||
for i:=1to proccallopts do
|
||||
if (proccallopt[i].mask in proccalloptions) then
|
||||
begin
|
||||
if first then
|
||||
first:=false
|
||||
else
|
||||
write(', ');
|
||||
write(proccallopt[i].str);
|
||||
end;
|
||||
writeln;
|
||||
end;
|
||||
ppufile^.getsmallset(procoptions);
|
||||
if procoptions<>[] then
|
||||
begin
|
||||
write(space,' Options : ');
|
||||
first:=true;
|
||||
for i:=1to procopts do
|
||||
if (procoptions and procopt[i].mask)<>0 then
|
||||
if (procopt[i].mask in procoptions) then
|
||||
begin
|
||||
if first then
|
||||
first:=false
|
||||
@ -353,36 +456,47 @@ end;
|
||||
|
||||
procedure readcommonsym(const s:string);
|
||||
type
|
||||
tsymoption=(sp_none,
|
||||
sp_public,
|
||||
sp_private,
|
||||
sp_published,
|
||||
sp_protected,
|
||||
sp_forwarddef,
|
||||
sp_static,
|
||||
sp_primary_typesym { this is for typesym, to know who is the primary symbol of a def }
|
||||
);
|
||||
tsymoptions=set of tsymoption;
|
||||
tsymopt=record
|
||||
mask : longint;
|
||||
mask : tsymoption;
|
||||
str : string[30];
|
||||
end;
|
||||
const
|
||||
symopts=6;
|
||||
symopts=7;
|
||||
symopt : array[1..symopts] of tsymopt=(
|
||||
(mask:1; str:'Public'),
|
||||
(mask:2; str:'Private'),
|
||||
(mask:4; str:'Published'),
|
||||
(mask:8; str:'Protected'),
|
||||
(mask:$10; str:'ForwardDef'),
|
||||
(mask:$20; str:'Static')
|
||||
(mask:sp_public; str:'Public'),
|
||||
(mask:sp_private; str:'Private'),
|
||||
(mask:sp_published; str:'Published'),
|
||||
(mask:sp_protected; str:'Protected'),
|
||||
(mask:sp_forwarddef; str:'ForwardDef'),
|
||||
(mask:sp_static; str:'Static'),
|
||||
(mask:sp_primary_typesym;str:'PrimaryTypeSym')
|
||||
);
|
||||
var
|
||||
symoptions,
|
||||
symoptions : tsymoptions;
|
||||
i : longint;
|
||||
first : boolean;
|
||||
begin
|
||||
writeln(space,'** Symbol Nr. ',ppufile^.getword,' **');
|
||||
writeln(space,s,ppufile^.getstring);
|
||||
symoptions:=ppufile^.getbyte;
|
||||
if symoptions<>0 then
|
||||
ppufile^.getsmallset(symoptions);
|
||||
if symoptions<>[] then
|
||||
begin
|
||||
write(space,' File Pos: ');
|
||||
readposinfo;
|
||||
write(space,' Options: ');
|
||||
first:=true;
|
||||
for i:=1to symopts do
|
||||
if (symoptions and symopt[i].mask)<>0 then
|
||||
if (symopt[i].mask in symoptions) then
|
||||
begin
|
||||
if first then
|
||||
first:=false
|
||||
@ -409,6 +523,16 @@ end;
|
||||
****************************************************************************}
|
||||
|
||||
procedure readsymbols;
|
||||
|
||||
procedure readpropsymlist;
|
||||
begin
|
||||
repeat
|
||||
if not readsymref then
|
||||
break;
|
||||
write(space,' ');
|
||||
until false;
|
||||
end;
|
||||
|
||||
Const
|
||||
vo_is_C_var = 2;
|
||||
Type
|
||||
@ -517,7 +641,7 @@ begin
|
||||
readdefref;
|
||||
write (space,' DefinitionSym: ');
|
||||
readsymref;
|
||||
i:=getbyte;
|
||||
i:=getlongint;
|
||||
writeln(space,' Options: ',i);
|
||||
if (i and vo_is_C_var)<>0 then
|
||||
writeln(space,' Mangledname: ',getstring);
|
||||
@ -584,12 +708,12 @@ begin
|
||||
writeln(space,' Options: ',getlongint);
|
||||
writeln(space,' Index: ',getlongint);
|
||||
writeln(space,' Default: ',getlongint);
|
||||
write(space,' Read symbol: ');
|
||||
readsymref;
|
||||
write (space,' Read symbol: ');
|
||||
readpropsymlist;
|
||||
write (space,' Write symbol: ');
|
||||
readsymref;
|
||||
readpropsymlist;
|
||||
write (space,' Stored symbol: ');
|
||||
readsymref;
|
||||
readpropsymlist;
|
||||
write (space,' Read Definition: ');
|
||||
readdefref;
|
||||
write (space,' Write Definition: ');
|
||||
@ -1267,7 +1391,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.7 1999-08-13 21:25:35 peter
|
||||
Revision 1.8 1999-08-15 10:47:14 peter
|
||||
* updates for new options
|
||||
|
||||
Revision 1.7 1999/08/13 21:25:35 peter
|
||||
* updated flags
|
||||
|
||||
Revision 1.6 1999/07/27 23:45:29 peter
|
||||
|
||||
Loading…
Reference in New Issue
Block a user