|
|
@@ -1,1577 +0,0 @@
|
|
|
-{
|
|
|
- $Id$
|
|
|
- Copyright (c) 1998-2000 by the FPC Development Team
|
|
|
-
|
|
|
- Dumps the contents of a FPC unit file (PPU File)
|
|
|
-
|
|
|
- This program is free software; you can redistribute it and/or modify
|
|
|
- it under the terms of the GNU General Public License as published by
|
|
|
- the Free Software Foundation; either version 2 of the License, or
|
|
|
- (at your option) any later version.
|
|
|
-
|
|
|
- This program is distributed in the hope that it will be useful,
|
|
|
- but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
- GNU General Public License for more details.
|
|
|
-
|
|
|
- You should have received a copy of the GNU General Public License
|
|
|
- along with this program; if not, write to the Free Software
|
|
|
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
-
|
|
|
- ****************************************************************************}
|
|
|
-{$ifdef TP}
|
|
|
- {$N+,E+}
|
|
|
-{$endif}
|
|
|
-program pppdump;
|
|
|
-uses
|
|
|
-{$ifdef go32v2}
|
|
|
- dpmiexcp,
|
|
|
-{$endif go32v2}
|
|
|
- ppu;
|
|
|
-
|
|
|
-const
|
|
|
- Version = 'Version 1.10';
|
|
|
- Title = 'PPU-Analyser';
|
|
|
- Copyright = 'Copyright (c) 1998-2000 by the Free Pascal Development Team';
|
|
|
-
|
|
|
-{ verbosity }
|
|
|
- v_none = $0;
|
|
|
- v_header = $1;
|
|
|
- v_defs = $2;
|
|
|
- v_syms = $4;
|
|
|
- v_interface = $8;
|
|
|
- v_implementation = $10;
|
|
|
- v_browser = $20;
|
|
|
- v_all = $ff;
|
|
|
-
|
|
|
-var
|
|
|
- ppufile : pppufile;
|
|
|
- space : string;
|
|
|
- read_member : boolean;
|
|
|
- verbose : longint;
|
|
|
-
|
|
|
-{****************************************************************************
|
|
|
- Helper Routines
|
|
|
-****************************************************************************}
|
|
|
-
|
|
|
-const has_errors : boolean = false;
|
|
|
-Procedure Error(const S : string);
|
|
|
-Begin
|
|
|
- Writeln(S);
|
|
|
- has_errors:=true;
|
|
|
-End;
|
|
|
-
|
|
|
-Function Target2Str(w:longint):string;
|
|
|
-type
|
|
|
- ttarget = (target_none
|
|
|
- ,target_i386_GO32V1,target_i386_GO32V2,target_i386_linux,
|
|
|
- target_i386_OS2,target_i386_Win32
|
|
|
- ,target_m68k_Amiga,target_m68k_Atari,target_m68k_Mac,
|
|
|
- target_m68k_linux,target_m68k_PalmOS
|
|
|
- );
|
|
|
-const
|
|
|
- Targets : array[ttarget] of string[10]=('none',
|
|
|
- 'GO32V1','GO32V2','Linux-i386','OS/2','Win32',
|
|
|
- 'Amiga','Mac68k','Atari','Linux-m68k','PalmOs');
|
|
|
-begin
|
|
|
- if w<=ord(high(ttarget)) then
|
|
|
- Target2Str:=Targets[ttarget(w)]
|
|
|
- else
|
|
|
- Target2Str:='<Unknown>';
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-Function Cpu2Str(w:longint):string;
|
|
|
-type
|
|
|
- ttargetcpu=(no_cpu
|
|
|
- ,i386,m68k,alpha
|
|
|
- );
|
|
|
-const
|
|
|
- CpuTxt : array[ttargetcpu] of string[5]=
|
|
|
- ('none','i386','m68k','alpha');
|
|
|
-begin
|
|
|
- if w<=ord(high(ttargetcpu)) then
|
|
|
- Cpu2Str:=CpuTxt[ttargetcpu(w)]
|
|
|
- else
|
|
|
- Cpu2Str:='<Unknown>';
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-function PPUFlags2Str(flags:longint):string;
|
|
|
-type
|
|
|
- tflagopt=record
|
|
|
- mask : longint;
|
|
|
- str : string[30];
|
|
|
- end;
|
|
|
-const
|
|
|
- flagopts=11;
|
|
|
- flagopt : array[1..flagopts] of tflagopt=(
|
|
|
- (mask: $1 ;str:'init'),
|
|
|
- (mask: $2 ;str:'final'),
|
|
|
- (mask: $4 ;str:'big_endian'),
|
|
|
- (mask: $8 ;str:'dbx'),
|
|
|
- (mask: $10 ;str:'browser'),
|
|
|
- (mask: $20 ;str:'in_library'),
|
|
|
- (mask: $40 ;str:'smart_linked'),
|
|
|
- (mask: $80 ;str:'static_linked'),
|
|
|
- (mask: $100 ;str:'shared_linked'),
|
|
|
- (mask: $200 ;str:'local_browser'),
|
|
|
- (mask: $400 ;str:'no_link')
|
|
|
- );
|
|
|
-var
|
|
|
- i : longint;
|
|
|
- first : boolean;
|
|
|
- s : string;
|
|
|
-begin
|
|
|
- s:='';
|
|
|
- if flags<>0 then
|
|
|
- begin
|
|
|
- first:=true;
|
|
|
- for i:=1to flagopts do
|
|
|
- if (flags and flagopt[i].mask)<>0 then
|
|
|
- begin
|
|
|
- if first then
|
|
|
- first:=false
|
|
|
- else
|
|
|
- s:=s+', ';
|
|
|
- s:=s+flagopt[i].str;
|
|
|
- end;
|
|
|
- end
|
|
|
- else
|
|
|
- s:='none';
|
|
|
- PPUFlags2Str:=s;
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-const
|
|
|
- HexTbl : array[0..15] of char='0123456789ABCDEF';
|
|
|
-function HexB(b:byte):string;
|
|
|
-begin
|
|
|
- HexB[0]:=#2;
|
|
|
- HexB[1]:=HexTbl[b shr 4];
|
|
|
- HexB[2]:=HexTbl[b and $f];
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-{****************************************************************************
|
|
|
- Read Routines
|
|
|
-****************************************************************************}
|
|
|
-
|
|
|
-Procedure ReadLinkContainer(const prefix:string);
|
|
|
-{
|
|
|
- Read a serie of strings and write to the screen starting every line
|
|
|
- with prefix
|
|
|
-}
|
|
|
- function maskstr(m:longint):string;
|
|
|
- const
|
|
|
- { link options }
|
|
|
- link_none = $0;
|
|
|
- link_allways = $1;
|
|
|
- link_static = $2;
|
|
|
- link_smart = $4;
|
|
|
- link_shared = $8;
|
|
|
- var
|
|
|
- s : string;
|
|
|
- begin
|
|
|
- s:='';
|
|
|
- if (m and link_allways)<>0 then
|
|
|
- s:=s+'always ';
|
|
|
- if (m and link_static)<>0 then
|
|
|
- s:=s+'static ';
|
|
|
- if (m and link_smart)<>0 then
|
|
|
- s:=s+'smart ';
|
|
|
- if (m and link_shared)<>0 then
|
|
|
- s:=s+'shared ';
|
|
|
- maskstr:=s;
|
|
|
- end;
|
|
|
-
|
|
|
-var
|
|
|
- s : string;
|
|
|
- m : longint;
|
|
|
-begin
|
|
|
- while not ppufile^.endofentry do
|
|
|
- begin
|
|
|
- s:=ppufile^.getstring;
|
|
|
- m:=ppufile^.getlongint;
|
|
|
- WriteLn(prefix,s,' (',maskstr(m),')');
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-Procedure ReadContainer(const prefix:string);
|
|
|
-{
|
|
|
- Read a serie of strings and write to the screen starting every line
|
|
|
- with prefix
|
|
|
-}
|
|
|
-begin
|
|
|
- while not ppufile^.endofentry do
|
|
|
- WriteLn(prefix,ppufile^.getstring);
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-Procedure ReadRef;
|
|
|
-begin
|
|
|
- if (verbose and v_browser)=0 then
|
|
|
- exit;
|
|
|
- while (not ppufile^.endofentry) and (not ppufile^.error) do
|
|
|
- Writeln(space,' - Refered : ',ppufile^.getword,', (',ppufile^.getlongint,',',ppufile^.getword,')');
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-Procedure ReadPosInfo;
|
|
|
-begin
|
|
|
- Writeln(ppufile^.getword,' (',ppufile^.getlongint,',',ppufile^.getword,')');
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-function readderef(const s:string;skipnil:boolean):boolean;
|
|
|
-type
|
|
|
- tdereftype = (derefnil,derefaktrecordindex,derefaktstaticindex,
|
|
|
- derefunit,derefrecord,derefindex,
|
|
|
- dereflocal,derefpara,derefaktlocalindex);
|
|
|
-var
|
|
|
- b : tdereftype;
|
|
|
-begin
|
|
|
- readderef:=true;
|
|
|
- repeat
|
|
|
- b:=tdereftype(ppufile^.getbyte);
|
|
|
- case b of
|
|
|
- derefnil :
|
|
|
- begin
|
|
|
- if not skipnil then
|
|
|
- writeln('nil');
|
|
|
- readderef:=false;
|
|
|
- break;
|
|
|
- end;
|
|
|
- derefaktrecordindex :
|
|
|
- begin
|
|
|
- writeln('AktRecord ',s,' ',ppufile^.getword);
|
|
|
- break;
|
|
|
- end;
|
|
|
- derefaktstaticindex :
|
|
|
- begin
|
|
|
- writeln('AktStatic ',s,' ',ppufile^.getword);
|
|
|
- break;
|
|
|
- end;
|
|
|
- derefaktlocalindex :
|
|
|
- begin
|
|
|
- writeln('AktLocal ',s,' ',ppufile^.getword);
|
|
|
- break;
|
|
|
- end;
|
|
|
- derefunit :
|
|
|
- begin
|
|
|
- writeln('Unit ',ppufile^.getword);
|
|
|
- break;
|
|
|
- end;
|
|
|
- derefrecord :
|
|
|
- begin
|
|
|
- write('RecordDef ',ppufile^.getword,', ');
|
|
|
- end;
|
|
|
- derefpara :
|
|
|
- begin
|
|
|
- write('Parameter of procdef ',ppufile^.getword,', ');
|
|
|
- end;
|
|
|
- dereflocal :
|
|
|
- begin
|
|
|
- write('Local of procdef ',ppufile^.getword,', ');
|
|
|
- end;
|
|
|
- derefindex :
|
|
|
- begin
|
|
|
- write(s,' ',ppufile^.getword,', ');
|
|
|
- end;
|
|
|
- else
|
|
|
- begin
|
|
|
- writeln('!! unsupported dereftyp: ',ord(b));
|
|
|
- break;
|
|
|
- end;
|
|
|
- end;
|
|
|
- until false;
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-function readdefref:boolean;
|
|
|
-begin
|
|
|
- readdefref:=readderef('Definition',false);
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-function readsymref:boolean;
|
|
|
-begin
|
|
|
- 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;
|
|
|
-
|
|
|
-
|
|
|
-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 : tprocoption;
|
|
|
- str : string[30];
|
|
|
- end;
|
|
|
-const
|
|
|
- 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: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
|
|
|
- proctypeoption : tproctypeoption;
|
|
|
- proccalloptions : tproccalloptions;
|
|
|
- procoptions : tprocoptions;
|
|
|
- i,params : longint;
|
|
|
- first : boolean;
|
|
|
-begin
|
|
|
- write(space,' Return type : ');
|
|
|
- readtype;
|
|
|
- writeln(space,' Fpu used : ',ppufile^.getbyte);
|
|
|
- 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 proccalloptions<>[] 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 (procopt[i].mask in procoptions) then
|
|
|
- begin
|
|
|
- if first then
|
|
|
- first:=false
|
|
|
- else
|
|
|
- write(', ');
|
|
|
- write(procopt[i].str);
|
|
|
- end;
|
|
|
- writeln;
|
|
|
- end;
|
|
|
- params:=ppufile^.getword;
|
|
|
- writeln(space,' Nr of parameters : ',params);
|
|
|
- if params>0 then
|
|
|
- begin
|
|
|
- repeat
|
|
|
- write(space,' - ',tvarspez[ppufile^.getbyte],' : ');
|
|
|
- readtype;
|
|
|
- write(space,' Default : ');
|
|
|
- readsymref;
|
|
|
- dec(params);
|
|
|
- until params=0;
|
|
|
- end;
|
|
|
-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 : tsymoption;
|
|
|
- str : string[30];
|
|
|
- end;
|
|
|
-const
|
|
|
- symopts=7;
|
|
|
- symopt : array[1..symopts] of tsymopt=(
|
|
|
- (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 : tsymoptions;
|
|
|
- i : longint;
|
|
|
- first : boolean;
|
|
|
-begin
|
|
|
- writeln(space,'** Symbol Nr. ',ppufile^.getword,' **');
|
|
|
- writeln(space,s,ppufile^.getstring);
|
|
|
- ppufile^.getsmallset(symoptions);
|
|
|
- if symoptions<>[] then
|
|
|
- begin
|
|
|
- write(space,' File Pos: ');
|
|
|
- readposinfo;
|
|
|
- write(space,' SymOptions: ');
|
|
|
- first:=true;
|
|
|
- for i:=1to symopts do
|
|
|
- if (symopt[i].mask in symoptions) then
|
|
|
- begin
|
|
|
- if first then
|
|
|
- first:=false
|
|
|
- else
|
|
|
- write(', ');
|
|
|
- write(symopt[i].str);
|
|
|
- end;
|
|
|
- writeln;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-procedure readcommondef(const s:string);
|
|
|
-begin
|
|
|
- writeln(space,'** Definition Nr. ',ppufile^.getword,' **');
|
|
|
- writeln(space,s);
|
|
|
- write (space,' Type symbol : ');
|
|
|
- readsymref;
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-{****************************************************************************
|
|
|
- Read Symbols Part
|
|
|
-****************************************************************************}
|
|
|
-
|
|
|
-procedure readsymbols;
|
|
|
-Const
|
|
|
- vo_is_C_var = 2;
|
|
|
-Type
|
|
|
- absolutetyp = (tovar,toasm,toaddr);
|
|
|
- tconsttyp = (constnone,
|
|
|
- constord,conststring,constreal,constbool,
|
|
|
- constint,constchar,constset,constpointer,constnil,
|
|
|
- constresourcestring
|
|
|
- );
|
|
|
-var
|
|
|
- b : byte;
|
|
|
- pc : pchar;
|
|
|
- totalsyms,
|
|
|
- symcnt,
|
|
|
- i,j,len : longint;
|
|
|
- l1,l2 : longint;
|
|
|
-begin
|
|
|
- symcnt:=1;
|
|
|
- with ppufile^ do
|
|
|
- begin
|
|
|
- if space<>'' then
|
|
|
- Writeln(space,'-----------------------------');
|
|
|
- if readentry=ibstartsyms then
|
|
|
- begin
|
|
|
- totalsyms:=getlongint;
|
|
|
- Writeln(space,'Number of symbols : ',totalsyms);
|
|
|
- Writeln(space,'Symtable datasize : ',getlongint);
|
|
|
- Writeln(space,'Symtable alignment: ',getlongint);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- totalsyms:=-1;
|
|
|
- Writeln('!! ibstartsym not found');
|
|
|
- end;
|
|
|
- repeat
|
|
|
- b:=readentry;
|
|
|
- if not (b in [iberror,ibendsyms]) then
|
|
|
- inc(symcnt);
|
|
|
- case b of
|
|
|
-
|
|
|
- ibunitsym :
|
|
|
- readcommonsym('Unit symbol ');
|
|
|
-
|
|
|
- iblabelsym :
|
|
|
- readcommonsym('Label symbol ');
|
|
|
-
|
|
|
- ibtypesym :
|
|
|
- begin
|
|
|
- readcommonsym('Type symbol ');
|
|
|
- write(space,' Result Type: ');
|
|
|
- readtype;
|
|
|
- end;
|
|
|
-
|
|
|
- ibprocsym :
|
|
|
- begin
|
|
|
- readcommonsym('Procedure symbol ');
|
|
|
- write(space,' Definition: ');
|
|
|
- readdefref;
|
|
|
- end;
|
|
|
-
|
|
|
- ibconstsym :
|
|
|
- begin
|
|
|
- readcommonsym('Constant symbol ');
|
|
|
- b:=getbyte;
|
|
|
- case tconsttyp(b) of
|
|
|
- constord :
|
|
|
- begin
|
|
|
- write (space,'OrdinalType: ');
|
|
|
- readtype;
|
|
|
- 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;
|
|
|
- constreal :
|
|
|
- writeln(space,' Value: ',getreal);
|
|
|
- constbool :
|
|
|
- if getlongint<>0 then
|
|
|
- writeln (space,' Value : True')
|
|
|
- else
|
|
|
- writeln (space,' Value: False');
|
|
|
- constint :
|
|
|
- begin
|
|
|
- l1:=getlongint;
|
|
|
- l2:=getlongint;
|
|
|
- writeln(space,' Value: ',int64(l2 shl 32) or l1);
|
|
|
- end;
|
|
|
- constchar :
|
|
|
- writeln(space,' Value: "'+chr(getlongint)+'"');
|
|
|
- constset :
|
|
|
- begin
|
|
|
- write (space,' Set Type: ');
|
|
|
- readtype;
|
|
|
- for i:=1to 4 do
|
|
|
- begin
|
|
|
- write (space,' Value: ');
|
|
|
- for j:=1to 8 do
|
|
|
- begin
|
|
|
- if j>1 then
|
|
|
- write(',');
|
|
|
- write(hexb(getbyte));
|
|
|
- end;
|
|
|
- writeln;
|
|
|
- end;
|
|
|
- end;
|
|
|
- else
|
|
|
- Writeln ('!! Invalid unit format : Invalid const type encountered: ',b);
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
- ibvarsym :
|
|
|
- begin
|
|
|
- readcommonsym('Variable symbol ');
|
|
|
- writeln(space,' Type: ',getbyte);
|
|
|
- if read_member then
|
|
|
- writeln(space,' Address: ',getlongint);
|
|
|
- write (space,' Var Type: ');
|
|
|
- readtype;
|
|
|
- i:=getlongint;
|
|
|
- writeln(space,' Options: ',i);
|
|
|
- if (i and vo_is_C_var)<>0 then
|
|
|
- writeln(space,' Mangledname: ',getstring);
|
|
|
- end;
|
|
|
-
|
|
|
- ibenumsym :
|
|
|
- begin
|
|
|
- readcommonsym('Enumeration symbol ');
|
|
|
- write (space,' Definition: ');
|
|
|
- readdefref;
|
|
|
- writeln(space,' Value: ',getlongint);
|
|
|
- end;
|
|
|
-
|
|
|
- ibsyssym :
|
|
|
- begin
|
|
|
- readcommonsym('Internal system symbol ');
|
|
|
- writeln(space,' Internal Nr: ',getlongint);
|
|
|
- end;
|
|
|
-
|
|
|
- ibtypedconstsym :
|
|
|
- begin
|
|
|
- readcommonsym('Typed constant ');
|
|
|
- write (space,' Constant Type: ');
|
|
|
- readtype;
|
|
|
- writeln(space,' Label: ',getstring);
|
|
|
- writeln(space,' ReallyConst: ',(getbyte<>0));
|
|
|
- end;
|
|
|
-
|
|
|
- ibabsolutesym :
|
|
|
- begin
|
|
|
- readcommonsym('Absolute variable symbol ');
|
|
|
- writeln(space,' Type: ',getbyte);
|
|
|
- if read_member then
|
|
|
- writeln(space,' Address: ',getlongint);
|
|
|
- write (space,' Var Type: ');
|
|
|
- readtype;
|
|
|
- writeln(space,' Options: ',getlongint);
|
|
|
- Write (space,' Relocated to ');
|
|
|
- b:=getbyte;
|
|
|
- case absolutetyp(b) of
|
|
|
- tovar :
|
|
|
- Writeln('Name : ',getstring);
|
|
|
- toasm :
|
|
|
- Writeln('Assembler name : ',getstring);
|
|
|
- toaddr :
|
|
|
- begin
|
|
|
- Write('Address : ',getlongint);
|
|
|
- WriteLn(' (Far: ',getbyte<>0,')');
|
|
|
- end;
|
|
|
- else
|
|
|
- Writeln ('!! Invalid unit format : Invalid absolute type encountered: ',b);
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
- ibpropertysym :
|
|
|
- begin
|
|
|
- readcommonsym('Property ');
|
|
|
- i:=getlongint;
|
|
|
- writeln(space,' PropOptions: ',i);
|
|
|
- if (i and 32)>0 then
|
|
|
- begin
|
|
|
- write (space,'OverrideProp: ');
|
|
|
- readsymref;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- write (space,' Prop Type: ');
|
|
|
- readtype;
|
|
|
- writeln(space,' Index: ',getlongint);
|
|
|
- writeln(space,' Default: ',getlongint);
|
|
|
- write (space,' Index Type: ');
|
|
|
- readtype;
|
|
|
- write (space,' Readaccess: ');
|
|
|
- readsymlist(space+' Sym: ');
|
|
|
- write (space,' Writeaccess: ');
|
|
|
- readsymlist(space+' Sym: ');
|
|
|
- write (space,'Storedaccess: ');
|
|
|
- readsymlist(space+' Sym: ');
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
- ibfuncretsym :
|
|
|
- begin
|
|
|
- readcommonsym('Func return value ');
|
|
|
- write (space,' Return Type: ');
|
|
|
- readtype;
|
|
|
- writeln(space,' Address: ',getlongint);
|
|
|
- end;
|
|
|
-
|
|
|
- iberror :
|
|
|
- begin
|
|
|
- Writeln('!! Error in PPU');
|
|
|
- exit;
|
|
|
- end;
|
|
|
-
|
|
|
- ibendsyms :
|
|
|
- break;
|
|
|
-
|
|
|
- else
|
|
|
- WriteLn('!! Skipping unsupported PPU Entry in Symbols: ',b);
|
|
|
- end;
|
|
|
- if not EndOfEntry then
|
|
|
- Writeln('!! Entry has more information stored');
|
|
|
- until false;
|
|
|
- if (totalsyms<>-1) and (symcnt-1<>totalsyms) then
|
|
|
- Writeln('!! Only read ',symcnt-1,' of ',totalsyms,' symbols');
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-{****************************************************************************
|
|
|
- Read defintions Part
|
|
|
-****************************************************************************}
|
|
|
-
|
|
|
-procedure readdefinitions(start_read : boolean);
|
|
|
-type
|
|
|
- tsettype = (normset,smallset,varset);
|
|
|
- tbasetype = (
|
|
|
- uauto,uvoid,uchar,
|
|
|
- u8bit,u16bit,u32bit,
|
|
|
- s8bit,s16bit,s32bit,
|
|
|
- bool8bit,bool16bit,bool32bit,
|
|
|
- u64bit,s64bit,uwidechar
|
|
|
- );
|
|
|
- tobjectdeftype = (odt_none,
|
|
|
- odt_class,
|
|
|
- odt_object,
|
|
|
- odt_interfacecom,
|
|
|
- odt_interfacecorba,
|
|
|
- odt_cppclass
|
|
|
- );
|
|
|
-var
|
|
|
- b : byte;
|
|
|
- oldread_member : boolean;
|
|
|
- totaldefs,l,j,
|
|
|
- defcnt : longint;
|
|
|
-begin
|
|
|
- defcnt:=0;
|
|
|
- with ppufile^ do
|
|
|
- begin
|
|
|
- if space<>'' then
|
|
|
- Writeln(space,'-----------------------------');
|
|
|
- if not start_read then
|
|
|
- if readentry=ibstartdefs then
|
|
|
- begin
|
|
|
- totaldefs:=getlongint;
|
|
|
- Writeln(space,'Number of definitions: ',totaldefs);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- totaldefs:=-1;
|
|
|
- Writeln('!! ibstartdef not found');
|
|
|
- end;
|
|
|
- repeat
|
|
|
- b:=readentry;
|
|
|
- if not (b in [iberror,ibenddefs]) then
|
|
|
- inc(defcnt);
|
|
|
- case b of
|
|
|
-
|
|
|
- ibpointerdef :
|
|
|
- begin
|
|
|
- readcommondef('Pointer definition');
|
|
|
- write (space,' Pointed Type : ');
|
|
|
- readtype;
|
|
|
- writeln(space,' Is Far : ',(getbyte<>0));
|
|
|
- end;
|
|
|
-
|
|
|
- iborddef :
|
|
|
- begin
|
|
|
- readcommondef('Ordinal definition');
|
|
|
- write (space,' Base type : ');
|
|
|
- b:=getbyte;
|
|
|
- case tbasetype(b) of
|
|
|
- uauto : writeln('uauto');
|
|
|
- uvoid : writeln('uvoid');
|
|
|
- uchar : writeln('uchar');
|
|
|
- u8bit : writeln('u8bit');
|
|
|
- u16bit : writeln('u16bit');
|
|
|
- u32bit : writeln('s32bit');
|
|
|
- s8bit : writeln('s8bit');
|
|
|
- s16bit : writeln('s16bit');
|
|
|
- s32bit : writeln('s32bit');
|
|
|
- bool8bit : writeln('bool8bit');
|
|
|
- bool16bit : writeln('bool16bit');
|
|
|
- bool32bit : writeln('bool32bit');
|
|
|
- u64bit : writeln('u64bit');
|
|
|
- s64bit : writeln('s64bit');
|
|
|
- uwidechar : writeln('uwidechar');
|
|
|
- else writeln('!! Warning: Invalid base type ',b);
|
|
|
- end;
|
|
|
- writeln(space,' Range : ',getlongint,' to ',getlongint);
|
|
|
- end;
|
|
|
-
|
|
|
- ibfloatdef :
|
|
|
- begin
|
|
|
- readcommondef('Float definition');
|
|
|
- writeln(space,' Float type : ',getbyte);
|
|
|
- end;
|
|
|
-
|
|
|
- ibarraydef :
|
|
|
- begin
|
|
|
- readcommondef('Array definition');
|
|
|
- write (space,' Element type : ');
|
|
|
- readtype;
|
|
|
- write (space,' Range Type : ');
|
|
|
- readtype;
|
|
|
- writeln(space,' Range : ',getlongint,' to ',getlongint);
|
|
|
- writeln(space,' Is Constructor : ',(getbyte<>0));
|
|
|
- end;
|
|
|
-
|
|
|
- ibprocdef :
|
|
|
- begin
|
|
|
- readcommondef('Procedure definition');
|
|
|
- read_abstract_proc_def;
|
|
|
- writeln(space,' Used Register : ',getbyte);
|
|
|
- writeln(space,' Mangled name : ',getstring);
|
|
|
- writeln(space,' Number : ',getlongint);
|
|
|
- write (space,' Next : ');
|
|
|
- readdefref;
|
|
|
- write (space,' Class : ');
|
|
|
- readdefref;
|
|
|
- write (space,' File Pos : ');
|
|
|
- readposinfo;
|
|
|
- space:=' '+space;
|
|
|
- { parast }
|
|
|
- readdefinitions(false);
|
|
|
- readsymbols;
|
|
|
- { localst }
|
|
|
- {readdefinitions(false);
|
|
|
- readsymbols;}
|
|
|
- delete(space,1,4);
|
|
|
- end;
|
|
|
-
|
|
|
- ibprocvardef :
|
|
|
- begin
|
|
|
- readcommondef('Procedural type (ProcVar) definition');
|
|
|
- read_abstract_proc_def;
|
|
|
- end;
|
|
|
-
|
|
|
- ibshortstringdef :
|
|
|
- begin
|
|
|
- readcommondef('ShortString definition');
|
|
|
- writeln(space,' Length : ',getbyte);
|
|
|
- end;
|
|
|
-
|
|
|
- ibwidestringdef :
|
|
|
- begin
|
|
|
- readcommondef('WideString definition');
|
|
|
- writeln(space,' Length : ',getlongint);
|
|
|
- end;
|
|
|
-
|
|
|
- ibansistringdef :
|
|
|
- begin
|
|
|
- readcommondef('AnsiString definition');
|
|
|
- writeln(space,' Length : ',getlongint);
|
|
|
- end;
|
|
|
-
|
|
|
- iblongstringdef :
|
|
|
- begin
|
|
|
- readcommondef('Longstring definition');
|
|
|
- writeln(space,' Length : ',getlongint);
|
|
|
- end;
|
|
|
-
|
|
|
- ibrecorddef :
|
|
|
- begin
|
|
|
- readcommondef('Record definition');
|
|
|
- writeln(space,' Size : ',getlongint);
|
|
|
- {read the record definitions and symbols}
|
|
|
- space:=' '+space;
|
|
|
- oldread_member:=read_member;
|
|
|
- read_member:=true;
|
|
|
- readdefinitions(false);
|
|
|
- readsymbols;
|
|
|
- read_member:=oldread_member;
|
|
|
- Delete(space,1,4);
|
|
|
- end;
|
|
|
-
|
|
|
- ibobjectdef :
|
|
|
- begin
|
|
|
- readcommondef('Object/Class definition');
|
|
|
- b:=getbyte;
|
|
|
- write (space,' Type : ');
|
|
|
- case tobjectdeftype(b) of
|
|
|
- odt_class : writeln('class');
|
|
|
- odt_object : writeln('object');
|
|
|
- odt_interfacecom : writeln('interfacecom');
|
|
|
- odt_interfacecorba : writeln('interfacecorba');
|
|
|
- odt_cppclass : writeln('cppclass');
|
|
|
- else writeln('!! Warning: Invalid object type ',b);
|
|
|
- end;
|
|
|
- writeln(space,' Size : ',getlongint);
|
|
|
- writeln(space,' Vmt offset : ',getlongint);
|
|
|
- writeln(space,' Name of Class : ',getstring);
|
|
|
- write(space, ' Ancestor Class : ');
|
|
|
- readdefref;
|
|
|
- writeln(space,' Options : ',getlongint);
|
|
|
- writeln(space,' Has RTTI : ',(getbyte<>0));
|
|
|
-
|
|
|
- if tobjectdeftype(b) in [odt_interfacecom,odt_interfacecorba] then
|
|
|
- begin
|
|
|
- writeln(space,' GUID Valid : ',(getbyte<>0));
|
|
|
- { IIDGUID }
|
|
|
- for j:=1to 16 do
|
|
|
- getbyte;
|
|
|
- writeln(space,' IID String : ',getstring);
|
|
|
- writeln(space,' Last VTable idx : ',getlongint);
|
|
|
- end;
|
|
|
-
|
|
|
- if tobjectdeftype(b) in [odt_class,odt_interfacecorba] then
|
|
|
- begin
|
|
|
- l:=getlongint;
|
|
|
- writeln(space,' Impl Intf Count : ',l);
|
|
|
- for j:=1 to l do
|
|
|
- begin
|
|
|
- write (space,' - Definition : ');
|
|
|
- readdefref;
|
|
|
- writeln(space,' IOffset : ',getlongint);
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
- {read the record definitions and symbols}
|
|
|
- space:=' '+space;
|
|
|
- oldread_member:=read_member;
|
|
|
- read_member:=true;
|
|
|
- readdefinitions(false);
|
|
|
- readsymbols;
|
|
|
- read_member:=oldread_member;
|
|
|
- Delete(space,1,4);
|
|
|
- end;
|
|
|
-
|
|
|
- ibfiledef :
|
|
|
- begin
|
|
|
- ReadCommonDef('File definition');
|
|
|
- write (space,' Type : ');
|
|
|
- case getbyte of
|
|
|
- 0 : writeln('Text');
|
|
|
- 1 : begin
|
|
|
- writeln('Typed');
|
|
|
- write (space,' File of Type : ');
|
|
|
- Readtype;
|
|
|
- end;
|
|
|
- 2 : writeln('Untyped');
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
- ibformaldef :
|
|
|
- readcommondef('Generic Definition (void-typ)');
|
|
|
-
|
|
|
- ibenumdef :
|
|
|
- begin
|
|
|
- readcommondef('Enumeration type definition');
|
|
|
- write(space,'Base enumeration type : ');
|
|
|
- readdefref;
|
|
|
- writeln(space,' Smallest element : ',getlongint);
|
|
|
- writeln(space,' Largest element : ',getlongint);
|
|
|
- writeln(space,' Size : ',getlongint);
|
|
|
- end;
|
|
|
-
|
|
|
- ibclassrefdef :
|
|
|
- begin
|
|
|
- readcommondef('Class reference definition');
|
|
|
- write (space,' Pointed Type : ');
|
|
|
- readtype;
|
|
|
- end;
|
|
|
-
|
|
|
- ibsetdef :
|
|
|
- begin
|
|
|
- readcommondef('Set definition');
|
|
|
- write (space,' Element type : ');
|
|
|
- readtype;
|
|
|
- b:=getbyte;
|
|
|
- case tsettype(b) of
|
|
|
- smallset : writeln(space,' Set with 32 Elements');
|
|
|
- normset : writeln(space,' Set with 256 Elements');
|
|
|
- varset : writeln(space,' Set with ',getlongint,' Elements');
|
|
|
- else writeln('!! Warning: Invalid set type ',b);
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- ibvariantdef :
|
|
|
- begin
|
|
|
- readcommondef('Variant definition');
|
|
|
- end;
|
|
|
-
|
|
|
- iberror :
|
|
|
- begin
|
|
|
- Writeln('!! Error in PPU');
|
|
|
- exit;
|
|
|
- end;
|
|
|
-
|
|
|
- ibenddefs :
|
|
|
- break;
|
|
|
-
|
|
|
- else
|
|
|
- WriteLn('!! Skipping unsupported PPU Entry in definitions: ',b);
|
|
|
- end;
|
|
|
- if not EndOfEntry then
|
|
|
- Writeln('!! Entry has more information stored');
|
|
|
- until false;
|
|
|
- if (totaldefs<>-1) and (defcnt<>totaldefs) then
|
|
|
- Writeln('!! Only read ',defcnt,' of ',totaldefs,' definitions');
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-{****************************************************************************
|
|
|
- Read General Part
|
|
|
-****************************************************************************}
|
|
|
-
|
|
|
-procedure readinterface;
|
|
|
-var
|
|
|
- b : byte;
|
|
|
- sourcenumber,
|
|
|
- unitnumber : word;
|
|
|
- ucrc,uintfcrc : longint;
|
|
|
-begin
|
|
|
- with ppufile^ do
|
|
|
- begin
|
|
|
- repeat
|
|
|
- b:=readentry;
|
|
|
- case b of
|
|
|
-
|
|
|
- ibmodulename :
|
|
|
- Writeln('Module Name: ',getstring);
|
|
|
-
|
|
|
- ibsourcefiles :
|
|
|
- begin
|
|
|
- sourcenumber:=1;
|
|
|
- while not EndOfEntry do
|
|
|
- begin
|
|
|
- Writeln('Source file ',sourcenumber,' : ',getstring);
|
|
|
- inc(sourcenumber);
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
- ibusedmacros :
|
|
|
- begin
|
|
|
- while not EndOfEntry do
|
|
|
- begin
|
|
|
- Write('Conditional ',getstring);
|
|
|
- b:=getbyte;
|
|
|
- if boolean(b)=true then
|
|
|
- write(' defined at startup')
|
|
|
- else
|
|
|
- write(' not defined at startup');
|
|
|
- b:=getbyte;
|
|
|
- if boolean(b)=true then
|
|
|
- writeln(' was used')
|
|
|
- else
|
|
|
- writeln;
|
|
|
- end;
|
|
|
- end;
|
|
|
- ibloadunit :
|
|
|
- begin
|
|
|
- unitnumber:=1;
|
|
|
- while not EndOfEntry do
|
|
|
- begin
|
|
|
- write('Uses unit: ',getstring,' (Number: ',unitnumber,')');
|
|
|
- ucrc:=getlongint;
|
|
|
- uintfcrc:=getlongint;
|
|
|
- write(' (Crc: ',ucrc,', IntfcCrc: ',uintfcrc,')');
|
|
|
- if getbyte<>0 then
|
|
|
- writeln(' (interface)')
|
|
|
- else
|
|
|
- writeln(' (implementation)');
|
|
|
- inc(unitnumber);
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
- iblinkunitofiles :
|
|
|
- ReadLinkContainer('Link unit object file: ');
|
|
|
-
|
|
|
- iblinkunitstaticlibs :
|
|
|
- ReadLinkContainer('Link unit static lib: ');
|
|
|
-
|
|
|
- iblinkunitsharedlibs :
|
|
|
- ReadLinkContainer('Link unit shared lib: ');
|
|
|
-
|
|
|
- iblinkotherofiles :
|
|
|
- ReadLinkContainer('Link other object file: ');
|
|
|
-
|
|
|
- iblinkotherstaticlibs :
|
|
|
- ReadLinkContainer('Link other static lib: ');
|
|
|
-
|
|
|
- iblinkothersharedlibs :
|
|
|
- ReadLinkContainer('Link other shared lib: ');
|
|
|
-
|
|
|
- iberror :
|
|
|
- begin
|
|
|
- Writeln('Error in PPU');
|
|
|
- exit;
|
|
|
- end;
|
|
|
-
|
|
|
- ibendinterface :
|
|
|
- break;
|
|
|
-
|
|
|
- else
|
|
|
- WriteLn('!! Skipping unsupported PPU Entry in General Part: ',b);
|
|
|
- end;
|
|
|
- until false;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-
|
|
|
-{****************************************************************************
|
|
|
- Read Implementation Part
|
|
|
-****************************************************************************}
|
|
|
-
|
|
|
-procedure readimplementation;
|
|
|
-var
|
|
|
- b : byte;
|
|
|
-begin
|
|
|
- with ppufile^ do
|
|
|
- begin
|
|
|
- repeat
|
|
|
- b:=readentry;
|
|
|
- case b of
|
|
|
- iberror :
|
|
|
- begin
|
|
|
- Writeln('Error in PPU');
|
|
|
- exit;
|
|
|
- end;
|
|
|
- ibendimplementation :
|
|
|
- break;
|
|
|
- else
|
|
|
- WriteLn('!! Skipping unsupported PPU Entry in Implementation: ',b);
|
|
|
- end;
|
|
|
- until false;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-{****************************************************************************
|
|
|
- Read Browser Part
|
|
|
-****************************************************************************}
|
|
|
-
|
|
|
-procedure readbrowser;
|
|
|
-var
|
|
|
- b : byte;
|
|
|
-const indent : string = '';
|
|
|
-begin
|
|
|
- Writeln(indent,'Start of symtable browser');
|
|
|
- indent:=indent+'**';
|
|
|
- with ppufile^ do
|
|
|
- begin
|
|
|
- repeat
|
|
|
- b:=readentry;
|
|
|
- case b of
|
|
|
- ibbeginsymtablebrowser :
|
|
|
- { here we must read object and record symtables !! }
|
|
|
- begin
|
|
|
- indent:=indent+' ';
|
|
|
- Writeln(indent,'Record/Object symtable');
|
|
|
- readbrowser;
|
|
|
- Indent:=Copy(Indent,1,Length(Indent)-2);
|
|
|
- end;
|
|
|
- ibsymref : begin
|
|
|
- readsymref;
|
|
|
- readref;
|
|
|
- end;
|
|
|
- ibdefref : begin
|
|
|
- readdefref;
|
|
|
- readref;
|
|
|
- if (ppufile^.header.flags and uf_local_browser)<>0 then
|
|
|
- begin
|
|
|
- { parast and localst }
|
|
|
- indent:=indent+' ';
|
|
|
- Writeln(indent,'Parasymtable for function');
|
|
|
- readdefinitions(false);
|
|
|
- readsymbols;
|
|
|
- b:=ppufile^.readentry;
|
|
|
- if b=ibbeginsymtablebrowser then
|
|
|
- readbrowser;
|
|
|
- Writeln(indent,'Localsymtable for function');
|
|
|
- readdefinitions(false);
|
|
|
- readsymbols;
|
|
|
- b:=ppufile^.readentry;
|
|
|
- if b=ibbeginsymtablebrowser then
|
|
|
- readbrowser;
|
|
|
- Indent:=Copy(Indent,1,Length(Indent)-2);
|
|
|
- end;
|
|
|
- end;
|
|
|
- iberror : begin
|
|
|
- Writeln('Error in PPU');
|
|
|
- exit;
|
|
|
- end;
|
|
|
- ibendsymtablebrowser : break;
|
|
|
- else
|
|
|
- begin
|
|
|
- WriteLn('!! Skipping unsupported PPU Entry in Browser: ',b);
|
|
|
- Halt;
|
|
|
- end;
|
|
|
- end;
|
|
|
- until false;
|
|
|
- end;
|
|
|
- Indent:=Copy(Indent,1,Length(Indent)-2);
|
|
|
- Writeln(Indent,'End of symtable browser');
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-
|
|
|
-
|
|
|
-procedure dofile (filename : string);
|
|
|
-var
|
|
|
- b,unitindex : byte;
|
|
|
-begin
|
|
|
-{ reset }
|
|
|
- space:='';
|
|
|
-{ fix filename }
|
|
|
- if pos('.',filename)=0 then
|
|
|
- filename:=filename+'.ppu';
|
|
|
- ppufile:=new(pppufile,Init(filename));
|
|
|
- if not ppufile^.open then
|
|
|
- begin
|
|
|
- writeln ('IO-Error when opening : ',filename,', Skipping');
|
|
|
- exit;
|
|
|
- end;
|
|
|
-{ PPU File is open, check for PPU Id }
|
|
|
- if not ppufile^.CheckPPUID then
|
|
|
- begin
|
|
|
- writeln(Filename,' : Not a valid PPU file, Skipping');
|
|
|
- exit;
|
|
|
- end;
|
|
|
-{ Check PPU Version }
|
|
|
- Writeln('Analyzing ',filename,' (v',ppufile^.GetPPUVersion,')');
|
|
|
- if ppufile^.GetPPUVersion<16 then
|
|
|
- begin
|
|
|
- writeln(Filename,' : Old PPU Formats (<v16) are not supported, Skipping');
|
|
|
- exit;
|
|
|
- end;
|
|
|
-{ Write PPU Header Information }
|
|
|
- if (verbose and v_header)<>0 then
|
|
|
- begin
|
|
|
- Writeln;
|
|
|
- Writeln('Header');
|
|
|
- Writeln('-------');
|
|
|
- with ppufile^.header do
|
|
|
- begin
|
|
|
- Writeln('Compiler version : ',hi(ppufile^.header.compiler and $ff),'.',lo(ppufile^.header.compiler));
|
|
|
- WriteLn('Target processor : ',Cpu2Str(cpu));
|
|
|
- WriteLn('Target operating system : ',Target2Str(target));
|
|
|
- Writeln('Unit flags : ',PPUFlags2Str(flags));
|
|
|
- Writeln('FileSize (w/o header) : ',size);
|
|
|
- Writeln('Checksum : ',checksum);
|
|
|
- Writeln('Interface Checksum : ',interface_checksum);
|
|
|
- end;
|
|
|
- end;
|
|
|
-{read the general stuff}
|
|
|
- if (verbose and v_interface)<>0 then
|
|
|
- begin
|
|
|
- Writeln;
|
|
|
- Writeln('Interface section');
|
|
|
- Writeln('------------------');
|
|
|
- readinterface;
|
|
|
- end
|
|
|
- else
|
|
|
- ppufile^.skipuntilentry(ibendinterface);
|
|
|
-{read the definitions}
|
|
|
- if (verbose and v_defs)<>0 then
|
|
|
- begin
|
|
|
- Writeln;
|
|
|
- Writeln('Interface definitions');
|
|
|
- Writeln('----------------------');
|
|
|
- readdefinitions(false);
|
|
|
- end
|
|
|
- else
|
|
|
- ppufile^.skipuntilentry(ibenddefs);
|
|
|
-{read the symbols}
|
|
|
- if (verbose and v_syms)<>0 then
|
|
|
- begin
|
|
|
- Writeln;
|
|
|
- Writeln('Interface Symbols');
|
|
|
- Writeln('------------------');
|
|
|
- readsymbols;
|
|
|
- end
|
|
|
- else
|
|
|
- ppufile^.skipuntilentry(ibendsyms);
|
|
|
-{read the implementation stuff}
|
|
|
-{ Not used at the moment (PFV)
|
|
|
- if (verbose and v_implementation)<>0 then
|
|
|
- begin
|
|
|
- Writeln;
|
|
|
- Writeln('Implementation section');
|
|
|
- Writeln('-----------------------');
|
|
|
- readimplementation;
|
|
|
- end
|
|
|
- else}
|
|
|
- ppufile^.skipuntilentry(ibendimplementation);
|
|
|
-{read the static browser units stuff}
|
|
|
- if (ppufile^.header.flags and uf_local_browser)<>0 then
|
|
|
- begin
|
|
|
- if (verbose and v_defs)<>0 then
|
|
|
- begin
|
|
|
- Writeln;
|
|
|
- Writeln('Static definitions');
|
|
|
- Writeln('----------------------');
|
|
|
- readdefinitions(false);
|
|
|
- end
|
|
|
- else
|
|
|
- ppufile^.skipuntilentry(ibenddefs);
|
|
|
- {read the symbols}
|
|
|
- if (verbose and v_syms)<>0 then
|
|
|
- begin
|
|
|
- Writeln;
|
|
|
- Writeln('Static Symbols');
|
|
|
- Writeln('------------------');
|
|
|
- readsymbols;
|
|
|
- end;
|
|
|
- end;
|
|
|
-{read the browser units stuff}
|
|
|
- if (ppufile^.header.flags and uf_has_browser)<>0 then
|
|
|
- begin
|
|
|
- if (verbose and v_browser)<>0 then
|
|
|
- begin
|
|
|
- Writeln;
|
|
|
- Writeln('Browser section');
|
|
|
- Writeln('---------------');
|
|
|
- UnitIndex:=0;
|
|
|
- repeat
|
|
|
- b:=ppufile^.readentry;
|
|
|
- if b = ibendbrowser then break;
|
|
|
- if b=ibbeginsymtablebrowser then
|
|
|
- begin
|
|
|
- Writeln('Unit ',UnitIndex);
|
|
|
- readbrowser;
|
|
|
- Inc(UnitIndex);
|
|
|
- end
|
|
|
- else
|
|
|
- Writeln('Wrong end browser entry ',b,' should be ',ibendbrowser);
|
|
|
- until false;
|
|
|
- end;
|
|
|
- end;
|
|
|
-{read the static browser units stuff}
|
|
|
- if (ppufile^.header.flags and uf_local_browser)<>0 then
|
|
|
- begin
|
|
|
- if (verbose and v_browser)<>0 then
|
|
|
- begin
|
|
|
- Writeln;
|
|
|
- Writeln('Static browser section');
|
|
|
- Writeln('---------------');
|
|
|
- b:=ppufile^.readentry;
|
|
|
- if b=ibbeginsymtablebrowser then
|
|
|
- begin
|
|
|
- Writeln('Unit ',UnitIndex);
|
|
|
- readbrowser;
|
|
|
- Inc(UnitIndex);
|
|
|
- end
|
|
|
- else
|
|
|
- Writeln('Wrong end browser entry ',b,' should be ',ibendbrowser);
|
|
|
- end;
|
|
|
- end;
|
|
|
-{shutdown ppufile}
|
|
|
- ppufile^.close;
|
|
|
- dispose(ppufile,done);
|
|
|
- Writeln;
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-
|
|
|
-procedure help;
|
|
|
-begin
|
|
|
- writeln('usage: ppudump [options] <filename1> <filename2>...');
|
|
|
- writeln;
|
|
|
- writeln('[options] can be:');
|
|
|
- writeln(' -V<verbose> Set verbosity to <verbose>');
|
|
|
- writeln(' H - Show header info');
|
|
|
- writeln(' I - Show interface');
|
|
|
- writeln(' M - Show implementation');
|
|
|
- writeln(' S - Show interface symbols');
|
|
|
- writeln(' D - Show interface definitions');
|
|
|
- writeln(' B - Show browser info');
|
|
|
- writeln(' A - Show all');
|
|
|
- writeln(' -? This helpscreen');
|
|
|
- halt;
|
|
|
-end;
|
|
|
-
|
|
|
-var
|
|
|
- startpara,
|
|
|
- nrfile,i : longint;
|
|
|
- para : string;
|
|
|
-begin
|
|
|
- writeln(Title+' '+Version);
|
|
|
- writeln(Copyright);
|
|
|
- writeln;
|
|
|
- if paramcount<1 then
|
|
|
- begin
|
|
|
- writeln('usage: dumpppu [options] <filename1> <filename2>...');
|
|
|
- halt(1);
|
|
|
- end;
|
|
|
-{ turn verbose on by default }
|
|
|
- verbose:=v_all;
|
|
|
-{ read options }
|
|
|
- startpara:=1;
|
|
|
- while copy(paramstr(startpara),1,1)='-' do
|
|
|
- begin
|
|
|
- para:=paramstr(startpara);
|
|
|
- case upcase(para[2]) of
|
|
|
- 'V' : begin
|
|
|
- verbose:=0;
|
|
|
- for i:=3to length(para) do
|
|
|
- case upcase(para[i]) of
|
|
|
- 'H' : verbose:=verbose or v_header;
|
|
|
- 'I' : verbose:=verbose or v_interface;
|
|
|
- 'M' : verbose:=verbose or v_implementation;
|
|
|
- 'D' : verbose:=verbose or v_defs;
|
|
|
- 'S' : verbose:=verbose or v_syms;
|
|
|
- 'B' : verbose:=verbose or v_browser;
|
|
|
- 'A' : verbose:=verbose or v_all;
|
|
|
- end;
|
|
|
- end;
|
|
|
- '?' : help;
|
|
|
- end;
|
|
|
- inc(startpara);
|
|
|
- end;
|
|
|
-{ process files }
|
|
|
- for nrfile:=startpara to paramcount do
|
|
|
- dofile (paramstr(nrfile));
|
|
|
- if has_errors then
|
|
|
- Halt(1);
|
|
|
-end.
|
|
|
-{
|
|
|
- $Log$
|
|
|
- Revision 1.5 2001-04-10 21:21:41 peter
|
|
|
- * variantdef support
|
|
|
- * propertysym fixed
|
|
|
-
|
|
|
- Revision 1.4 2001/04/04 22:42:59 peter
|
|
|
- * updated for new objectdef with interfaces
|
|
|
-
|
|
|
- Revision 1.3 2000/09/09 19:46:40 peter
|
|
|
- * show dataalignment
|
|
|
-
|
|
|
- Revision 1.2 2000/08/13 12:58:06 peter
|
|
|
- * updated for ppu additions
|
|
|
-
|
|
|
- Revision 1.1 2000/07/13 10:16:22 michael
|
|
|
- + Initial import
|
|
|
-
|
|
|
- Revision 1.15 2000/07/04 19:05:54 peter
|
|
|
- * be optimistic: version 1.00 for some utils
|
|
|
-
|
|
|
- Revision 1.14 2000/02/09 16:44:14 peter
|
|
|
- * log truncated
|
|
|
-
|
|
|
- Revision 1.13 2000/01/23 16:34:36 peter
|
|
|
- * updated for new aktlocalindex
|
|
|
-
|
|
|
- Revision 1.12 2000/01/07 16:46:03 daniel
|
|
|
- * copyright 2000
|
|
|
-
|
|
|
- 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
|
|
|
-
|
|
|
- Revision 1.9 1999/08/31 16:07:37 pierre
|
|
|
- + support for writeusedmacros
|
|
|
-
|
|
|
- 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
|
|
|
- * updated for typesym writing
|
|
|
-
|
|
|
-}
|
peter