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

* updates for new options

Browse Source
This commit is contained in:
peter 1999-08-15 10:47:12 +00:00
parent 8d9aa81d3a
commit 30679bdff4
2 changed files with 218 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
utils/ppu.pas
View File

@ -37,7 +37,11 @@ type
{$endif Test_Double_checksum} {$endif Test_Double_checksum}
const const
{$ifdef newcg}
CurrentPPUVersion=100;
{$else newcg}
CurrentPPUVersion=17; CurrentPPUVersion=17;
{$endif newcg}
{ buffer sizes } { buffer sizes }
maxentrysize = 1024; maxentrysize = 1024;
@ -204,6 +208,8 @@ type
function getlongint:longint; function getlongint:longint;
function getreal:ppureal; function getreal:ppureal;
function getstring:string; function getstring:string;
procedure getnormalset(var b);
procedure getsmallset(var b);
function skipuntilentry(untilb:byte):boolean; function skipuntilentry(untilb:byte):boolean;
{write} {write}
function create:boolean; function create:boolean;
@ -217,6 +223,8 @@ type
procedure putlongint(l:longint); procedure putlongint(l:longint);
procedure putreal(d:ppureal); procedure putreal(d:ppureal);
procedure putstring(s:string); procedure putstring(s:string);
procedure putnormalset(var b);
procedure putsmallset(var b);
end; end;
implementation implementation
@ -652,6 +660,18 @@ begin
end; 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; function tppufile.skipuntilentry(untilb:byte):boolean;
var var
b : byte; b : byte;
@ -868,11 +888,26 @@ begin
end; end;
procedure tppufile.putsmallset(var b);
begin
putdata(b,4);
end;
procedure tppufile.putnormalset(var b);
begin
putdata(b,32);
end;
end. end.
{ {
$Log$ $Log$
Revision 1.3 1999-07-27 23:46:55 peter Revision 1.4 1999-08-15 10:47:12 peter
* version 17 ppu * 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 Revision 1.36 1999/07/23 16:05:25 peter
* alignment is now saved in the symtable * alignment is now saved in the symtable

235
utils/ppudump.pp
View File

@ -222,18 +222,20 @@ begin
end; end;
procedure readderef(const s:string); function readderef(const s:string):boolean;
type type
tdereftype = (derefnil,derefaktrecordindex,derefaktstaticindex,derefunit,derefrecord,derefindex); tdereftype = (derefnil,derefaktrecordindex,derefaktstaticindex,derefunit,derefrecord,derefindex);
var var
b : tdereftype; b : tdereftype;
begin begin
readderef:=true;
repeat repeat
b:=tdereftype(ppufile^.getbyte); b:=tdereftype(ppufile^.getbyte);
case b of case b of
derefnil : derefnil :
begin begin
writeln('nil'); writeln('nil');
readderef:=false;
break; break;
end; end;
derefaktrecordindex : derefaktrecordindex :
@ -264,68 +266,169 @@ begin
end; end;
procedure readdefref; function readdefref:boolean;
begin begin
readderef('Definition'); readdefref:=readderef('Definition');
end; end;
procedure readsymref; function readsymref:boolean;
begin begin
readderef('Symbol'); readsymref:=readderef('Symbol');
end; end;
procedure read_abstract_proc_def; procedure read_abstract_proc_def;
type 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 tprocopt=record
mask : longint; mask : tprocoption;
str : string[30]; str : string[30];
end; end;
const 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=( procopt : array[1..procopts] of tprocopt=(
(mask:1; str:'Exception handler'), (mask:po_classmethod; str:'ClassMethod'),
(mask:2; str:'Virtual Method'), (mask:po_virtualmethod; str:'VirtualMethod'),
(mask:4; str:'Stack is not cleared'), (mask:po_abstractmethod; str:'AbstractMethod'),
(mask:8; str:'Constructor'), (mask:po_staticmethod; str:'StaticMethod'),
(mask:$10; str:'Destructor'), (mask:po_overridingmethod;str:'OverridingMethod'),
(mask:$20; str:'Internal Procedure'), (mask:po_methodpointer; str:'MethodPointer'),
(mask:$40; str:'Exported Procedure'), (mask:po_containsself; str:'ContainsSelf'),
(mask:$80; str:'I/O-Checking'), (mask:po_interrupt; str:'Interrupt'),
(mask:$100; str:'Abstract method'), (mask:po_iocheck; str:'IOCheck'),
(mask:$200; str:'Interrupt Handler'), (mask:po_assembler; str:'Assembler'),
(mask:$400; str:'Inline Procedure'), (mask:po_msgstr; str:'MsgStr'),
(mask:$800; str:'Assembler Procedure'), (mask:po_msgint; str:'MsgInt'),
(mask:$1000; str:'Overloaded Operator'), (mask:po_exports; str:'Exports'),
(mask:$2000; str:'External Procedure'), (mask:po_external; str:'External'),
(mask:$4000; str:'Parameters from left to right'), (mask:po_savestdregs; str:'SaveStdRegs'),
(mask:$8000; str:'Main Program'), (mask:po_saveregisters; str:'SaveRegisters')
(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')
); );
tvarspez : array[0..2] of string[5]=('Value','Const','Var '); tvarspez : array[0..2] of string[5]=('Value','Const','Var ');
var var
procoptions, proctypeoption : tproctypeoption;
proccalloptions : tproccalloptions;
procoptions : tprocoptions;
i,params : longint; i,params : longint;
first : boolean; first : boolean;
begin begin
write(space,' Return type : '); write(space,' Return type : ');
readdefref; readdefref;
writeln(space,' Fpu used : ',ppufile^.getbyte); writeln(space,' Fpu used : ',ppufile^.getbyte);
procoptions:=ppufile^.getlongint; proctypeoption:=tproctypeoption(ppufile^.getlongint);
if procoptions<>0 then 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 begin
write(space,' Options : '); write(space,' Options : ');
first:=true; first:=true;
for i:=1to procopts do for i:=1to procopts do
if (procoptions and procopt[i].mask)<>0 then if (procopt[i].mask in procoptions) then
begin begin
if first then if first then
first:=false first:=false
@ -353,36 +456,47 @@ end;
procedure readcommonsym(const s:string); procedure readcommonsym(const s:string);
type 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 tsymopt=record
mask : longint; mask : tsymoption;
str : string[30]; str : string[30];
end; end;
const const
symopts=6; symopts=7;
symopt : array[1..symopts] of tsymopt=( symopt : array[1..symopts] of tsymopt=(
(mask:1; str:'Public'), (mask:sp_public; str:'Public'),
(mask:2; str:'Private'), (mask:sp_private; str:'Private'),
(mask:4; str:'Published'), (mask:sp_published; str:'Published'),
(mask:8; str:'Protected'), (mask:sp_protected; str:'Protected'),
(mask:$10; str:'ForwardDef'), (mask:sp_forwarddef; str:'ForwardDef'),
(mask:$20; str:'Static') (mask:sp_static; str:'Static'),
(mask:sp_primary_typesym;str:'PrimaryTypeSym')
); );
var var
symoptions, symoptions : tsymoptions;
i : longint; i : longint;
first : boolean; first : boolean;
begin begin
writeln(space,'** Symbol Nr. ',ppufile^.getword,' **'); writeln(space,'** Symbol Nr. ',ppufile^.getword,' **');
writeln(space,s,ppufile^.getstring); writeln(space,s,ppufile^.getstring);
symoptions:=ppufile^.getbyte; ppufile^.getsmallset(symoptions);
if symoptions<>0 then if symoptions<>[] then
begin begin
write(space,' File Pos: '); write(space,' File Pos: ');
readposinfo; readposinfo;
write(space,' Options: '); write(space,' Options: ');
first:=true; first:=true;
for i:=1to symopts do for i:=1to symopts do
if (symoptions and symopt[i].mask)<>0 then if (symopt[i].mask in symoptions) then
begin begin
if first then if first then
first:=false first:=false
@ -409,6 +523,16 @@ 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
@ -517,7 +641,7 @@ begin
readdefref; readdefref;
write (space,' DefinitionSym: '); write (space,' DefinitionSym: ');
readsymref; readsymref;
i:=getbyte; 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
writeln(space,' Mangledname: ',getstring); writeln(space,' Mangledname: ',getstring);
@ -584,12 +708,12 @@ begin
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,' Read symbol: ');
readsymref; readpropsymlist;
write (space,' Write symbol: '); write (space,' Write symbol: ');
readsymref; readpropsymlist;
write (space,' Stored symbol: '); write (space,' Stored symbol: ');
readsymref; readpropsymlist;
write (space,' Read Definition: '); write (space,' Read Definition: ');
readdefref; readdefref;
write (space,' Write Definition: '); write (space,' Write Definition: ');
@ -1267,7 +1391,10 @@ begin
end. end.
{ {
$Log$ $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 * updated flags
Revision 1.6 1999/07/27 23:45:29 peter Revision 1.6 1999/07/27 23:45:29 peter