Browse Source

Extract functionality that is shared between the metadata files for units (PPU) and for packages (PCP) into a parent class called tentryfile

+ add new unit entfile which contains the new tentryfile class and related types and constants
* ppu.pas:
    - remove methods, fields, types and constants which were moved to entfile.pas
    * replace the parts of tppuheader shared with tentryheader by a field of type tentryheader
fppu.pas, pmodules.pas, utils/ppumove.pp, utils/ppuutils/ppudump.pp:
    + add entfile to uses
    * adjust access to common header fields
node.pas, symdef.pas, symsym.pas, symtable.pas, wpoinfo.pas, utils/ppufiles.pp:
    + add entfile to uses

git-svn-id: branches/svenbarth/packages@28689 -
svenbarth 11 years ago
parent
commit
5e33294782

+ 1 - 0
.gitattributes

@@ -170,6 +170,7 @@ compiler/defcmp.pas svneol=native#text/plain
 compiler/defutil.pas svneol=native#text/plain
 compiler/defutil.pas svneol=native#text/plain
 compiler/dirparse.pas svneol=native#text/plain
 compiler/dirparse.pas svneol=native#text/plain
 compiler/elfbase.pas svneol=native#text/plain
 compiler/elfbase.pas svneol=native#text/plain
+compiler/entfile.pas svneol=native#text/pascal
 compiler/export.pas svneol=native#text/plain
 compiler/export.pas svneol=native#text/plain
 compiler/expunix.pas svneol=native#text/plain
 compiler/expunix.pas svneol=native#text/plain
 compiler/finput.pas svneol=native#text/plain
 compiler/finput.pas svneol=native#text/plain

+ 1143 - 0
compiler/entfile.pas

@@ -0,0 +1,1143 @@
+{
+    Copyright (c) 1998-2013 by Free Pascal development team
+
+    Routines to read/write entry based files (ppu, pcp)
+
+    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.
+
+ ****************************************************************************
+}
+unit entfile;
+
+{$i fpcdefs.inc}
+
+interface
+
+  uses
+    systems,globtype,constexp,cstreams;
+
+  const
+  { buffer sizes }
+    maxentrysize = 1024;
+    entryfilebufsize   = 16384;
+
+  {ppu entries}
+    mainentryid         = 1;
+    subentryid          = 2;
+    {special}
+    iberror             = 0;
+    ibstartdefs         = 248;
+    ibenddefs           = 249;
+    ibstartsyms         = 250;
+    ibendsyms           = 251;
+    ibendinterface      = 252;
+    ibendimplementation = 253;
+  //  ibendbrowser        = 254;
+    ibend               = 255;
+    {general}
+    ibmodulename           = 1;
+    ibsourcefiles          = 2;
+    ibloadunit             = 3;
+    ibinitunit             = 4;
+    iblinkunitofiles       = 5;
+    iblinkunitstaticlibs   = 6;
+    iblinkunitsharedlibs   = 7;
+    iblinkotherofiles      = 8;
+    iblinkotherstaticlibs  = 9;
+    iblinkothersharedlibs  = 10;
+    ibImportSymbols        = 11;
+    ibsymref               = 12;
+    ibdefref               = 13;
+  //  ibendsymtablebrowser   = 14;
+  //  ibbeginsymtablebrowser = 15;
+  {$IFDEF MACRO_DIFF_HINT}
+    ibusedmacros           = 16;
+  {$ENDIF}
+    ibderefdata            = 17;
+    ibexportedmacros       = 18;
+    ibderefmap             = 19;
+    {syms}
+    ibtypesym        = 20;
+    ibprocsym        = 21;
+    ibstaticvarsym   = 22;
+    ibconstsym       = 23;
+    ibenumsym        = 24;
+  //  ibtypedconstsym  = 25;
+    ibabsolutevarsym = 26;
+    ibpropertysym    = 27;
+    ibfieldvarsym    = 28;
+    ibunitsym        = 29;
+    iblabelsym       = 30;
+    ibsyssym         = 31;
+    ibnamespacesym   = 32;
+    iblocalvarsym    = 33;
+    ibparavarsym     = 34;
+    ibmacrosym       = 35;
+    {definitions}
+    iborddef         = 40;
+    ibpointerdef     = 41;
+    ibarraydef       = 42;
+    ibprocdef        = 43;
+    ibshortstringdef = 44;
+    ibrecorddef      = 45;
+    ibfiledef        = 46;
+    ibformaldef      = 47;
+    ibobjectdef      = 48;
+    ibenumdef        = 49;
+    ibsetdef         = 50;
+    ibprocvardef     = 51;
+    ibfloatdef       = 52;
+    ibclassrefdef    = 53;
+    iblongstringdef  = 54;
+    ibansistringdef  = 55;
+    ibwidestringdef  = 56;
+    ibvariantdef     = 57;
+    ibundefineddef   = 58;
+    ibunicodestringdef = 59;
+    {implementation/ObjData}
+    ibnodetree       = 80;
+    ibasmsymbols     = 81;
+    ibresources      = 82;
+    ibcreatedobjtypes = 83;
+    ibwpofile         = 84;
+    ibmoduleoptions   = 85;
+
+    ibmainname       = 90;
+    ibsymtableoptions = 91;
+    ibrecsymtableoptions = 91;
+    { target-specific things }
+    iblinkotherframeworks = 100;
+    ibjvmnamespace = 101;
+
+  {$ifdef generic_cpu}
+  { We need to use the correct size of aint and pint for
+    the target CPU }
+  const
+    CpuAddrBitSize : array[tsystemcpu] of longint =
+      (
+      {  0 } 32 {'none'},
+      {  1 } 32 {'i386'},
+      {  2 } 32 {'m68k'},
+      {  3 } 32 {'alpha'},
+      {  4 } 32 {'powerpc'},
+      {  5 } 32 {'sparc'},
+      {  6 } 32 {'vis'},
+      {  7 } 64 {'ia64'},
+      {  8 } 64 {'x86_64'},
+      {  9 } 32 {'mipseb'},
+      { 10 } 32 {'arm'},
+      { 11 } 64 {'powerpc64'},
+      { 12 } 16 {'avr'},
+      { 13 } 32 {'mipsel'},
+      { 14 } 32 {'jvm'},
+      { 15 } 16 {'i8086'}
+      );
+    CpuAluBitSize : array[tsystemcpu] of longint =
+      (
+      {  0 } 32 {'none'},
+      {  1 } 32 {'i386'},
+      {  2 } 32 {'m68k'},
+      {  3 } 32 {'alpha'},
+      {  4 } 32 {'powerpc'},
+      {  5 } 32 {'sparc'},
+      {  6 } 32 {'vis'},
+      {  7 } 64 {'ia64'},
+      {  8 } 64 {'x86_64'},
+      {  9 } 32 {'mipseb'},
+      { 10 } 32 {'arm'},
+      { 11 } 64 {'powerpc64'},
+      { 12 }  8 {'avr'},
+      { 13 } 32 {'mipsel'},
+      { 14 } 64 {'jvm'},
+      { 15 } 16 {'i8086'}
+      );
+  {$endif generic_cpu}
+
+  type
+
+    { bestreal is defined based on the target architecture }
+    entryreal=bestreal;
+
+    tentry=packed record
+      size : longint;
+      id   : byte;
+      nr   : byte;
+    end;
+
+    { common part of the header for all kinds of entry files }
+    tentryheader=record
+      id       : array[1..3] of char;
+      ver      : array[1..3] of char;
+      compiler : word;
+      cpu      : word;
+      target   : word;
+      flags    : longint;
+      size     : longint; { size of the ppufile without header }
+    end;
+    pentryheader=^tentryheader;
+
+    tentryfile=class
+    protected
+      buf      : pchar;
+      bufstart,
+      bufsize,
+      bufidx   : integer;
+      entrybufstart,
+      entrystart,
+      entryidx : integer;
+      entry    : tentry;
+      closed,
+      tempclosed : boolean;
+      closepos : integer;
+    protected
+      f        : TCCustomFileStream;
+      mode     : byte; {0 - Closed, 1 - Reading, 2 - Writing}
+      fname    : string;
+      fsize    : integer;
+      procedure newheader;virtual;abstract;
+      function readheader:longint;virtual;abstract;
+      function outputallowed:boolean;virtual;
+      procedure resetfile;virtual;abstract;
+      function getheadersize:longint;virtual;abstract;
+      function getheaderaddr:pentryheader;virtual;abstract;
+    public
+      entrytyp : byte;
+      size             : integer;
+      change_endian    : boolean; { Used in ppudump util }
+  {$ifdef generic_cpu}
+      has_more,
+  {$endif not generic_cpu}
+      error         : boolean;
+      constructor create(const fn:string);
+      destructor  destroy;override;
+      procedure flush;
+      procedure closefile;virtual;
+      procedure newentry;
+    {read}
+      function  openfile:boolean;
+      procedure reloadbuf;
+      procedure readdata(out b;len:integer);
+      procedure skipdata(len:integer);
+      function  readentry:byte;
+      function  EndOfEntry:boolean;
+      function  entrysize:longint;
+      function  entryleft:longint;
+      procedure getdatabuf(out b;len:integer;out res:integer);
+      procedure getdata(out b;len:integer);
+      function  getbyte:byte;
+      function  getword:word;
+      function  getdword:dword;
+      function  getlongint:longint;
+      function getint64:int64;
+      function  getqword:qword;
+      function getaint:aint;
+      function getasizeint:asizeint;
+      function getaword:aword;
+      function  getreal:entryreal;
+      function  getrealsize(sizeofreal : longint):entryreal;
+      function  getstring:string;
+      function  getansistring:ansistring;
+      procedure getnormalset(out b);
+      procedure getsmallset(out b);
+      function  skipuntilentry(untilb:byte):boolean;
+    {write}
+      function  createfile:boolean;virtual;
+      procedure writeheader;virtual;abstract;
+      procedure writebuf;
+      procedure writedata(const b;len:integer);
+      procedure writeentry(ibnr:byte);
+      procedure putdata(const b;len:integer);virtual;
+      procedure putbyte(b:byte);
+      procedure putword(w:word);
+      procedure putdword(w:dword);
+      procedure putlongint(l:longint);
+      procedure putint64(i:int64);
+      procedure putqword(q:qword);
+      procedure putaint(i:aint);
+      procedure putasizeint(i:asizeint);
+      procedure putaword(i:aword);
+      procedure putreal(d:entryreal);
+      procedure putstring(const s:string);
+      procedure putansistring(const s:ansistring);
+      procedure putnormalset(const b);
+      procedure putsmallset(const b);
+      procedure tempclose;        // MG: not used, obsolete?
+      function  tempopen:boolean; // MG: not used, obsolete?
+    end;
+
+
+implementation
+
+  uses
+    cutils;
+
+
+  function swapendian_entryreal(d:entryreal):entryreal;
+    type
+      entryreal_bytes=array[0..sizeof(d)-1] of byte;
+    var
+      i:0..sizeof(d)-1;
+    begin
+      for i:=low(entryreal_bytes) to high(entryreal_bytes) do
+        entryreal_bytes(result)[i]:=entryreal_bytes(d)[high(entryreal_bytes)-i];
+    end;
+
+{*****************************************************************************
+                                  tentryfile
+*****************************************************************************}
+
+    function tentryfile.outputallowed: boolean;
+    begin
+      result:=true;
+    end;
+
+
+  constructor tentryfile.create(const fn:string);
+    begin
+      fname:=fn;
+      change_endian:=false;
+      mode:=0;
+      newheader;
+      error:=false;
+      closed:=true;
+      tempclosed:=false;
+      getmem(buf,entryfilebufsize);
+    end;
+
+
+  destructor tentryfile.destroy;
+    begin
+      closefile;
+      if assigned(buf) then
+        freemem(buf,entryfilebufsize);
+    end;
+
+
+  procedure tentryfile.flush;
+    begin
+      if mode=2 then
+       writebuf;
+    end;
+
+
+  procedure tentryfile.closefile;
+    begin
+      if mode<>0 then
+       begin
+         flush;
+         f.Free;
+         mode:=0;
+         closed:=true;
+       end;
+    end;
+
+
+  {*****************************************************************************
+                                  tentryfile Reading
+  *****************************************************************************}
+
+  function tentryfile.openfile:boolean;
+    var
+      i      : integer;
+    begin
+      openfile:=false;
+      try
+        f:=CFileStreamClass.Create(fname,fmOpenRead)
+      except
+        exit;
+      end;
+      closed:=false;
+    {read ppuheader}
+      fsize:=f.Size;
+      i:=readheader;
+      if i<0 then
+        exit;
+    {reset buffer}
+      bufstart:=i;
+      bufsize:=0;
+      bufidx:=0;
+      mode:=1;
+      FillChar(entry,sizeof(tentry),0);
+      entryidx:=0;
+      entrystart:=0;
+      entrybufstart:=0;
+      error:=false;
+      openfile:=true;
+    end;
+
+
+  procedure tentryfile.reloadbuf;
+    begin
+      inc(bufstart,bufsize);
+      bufsize:=f.Read(buf^,entryfilebufsize);
+      bufidx:=0;
+    end;
+
+
+  procedure tentryfile.readdata(out b;len:integer);
+    var
+      p,pbuf : pchar;
+      left : integer;
+    begin
+      p:=pchar(@b);
+      pbuf:=@buf[bufidx];
+      repeat
+        left:=bufsize-bufidx;
+        if len<left then
+          break;
+        move(pbuf^,p^,left);
+        dec(len,left);
+        inc(p,left);
+        reloadbuf;
+        pbuf:=@buf[bufidx];
+        if bufsize=0 then
+          exit;
+      until false;
+      move(pbuf^,p^,len);
+      inc(bufidx,len);
+    end;
+
+
+  procedure tentryfile.skipdata(len:integer);
+    var
+      left : integer;
+    begin
+      while len>0 do
+       begin
+         left:=bufsize-bufidx;
+         if len>left then
+          begin
+            dec(len,left);
+            reloadbuf;
+            if bufsize=0 then
+             exit;
+          end
+         else
+          begin
+            inc(bufidx,len);
+            exit;
+          end;
+       end;
+    end;
+
+
+  function tentryfile.readentry:byte;
+    begin
+      if entryidx<entry.size then
+        begin
+{$ifdef generic_cpu}
+         has_more:=true;
+{$endif not generic_cpu}
+         skipdata(entry.size-entryidx);
+        end;
+      readdata(entry,sizeof(tentry));
+      if change_endian then
+        entry.size:=swapendian(entry.size);
+      entrystart:=bufstart+bufidx;
+      entryidx:=0;
+{$ifdef generic_cpu}
+      has_more:=false;
+{$endif not generic_cpu}
+      if not(entry.id in [mainentryid,subentryid]) then
+       begin
+         readentry:=iberror;
+         error:=true;
+         exit;
+       end;
+      readentry:=entry.nr;
+    end;
+
+
+  function tentryfile.endofentry:boolean;
+    begin
+{$ifdef generic_cpu}
+      endofentry:=(entryidx=entry.size);
+{$else not generic_cpu}
+      endofentry:=(entryidx>=entry.size);
+{$endif not generic_cpu}
+    end;
+
+
+  function tentryfile.entrysize:longint;
+    begin
+      entrysize:=entry.size;
+    end;
+
+  function tentryfile.entryleft:longint;
+    begin
+      entryleft:=entry.size-entryidx;
+    end;
+
+
+  procedure tentryfile.getdatabuf(out b;len:integer;out res:integer);
+    begin
+      if entryidx+len>entry.size then
+       res:=entry.size-entryidx
+      else
+       res:=len;
+      readdata(b,res);
+      inc(entryidx,res);
+    end;
+
+
+  procedure tentryfile.getdata(out b;len:integer);
+    begin
+      if entryidx+len>entry.size then
+       begin
+         error:=true;
+         exit;
+       end;
+      readdata(b,len);
+      inc(entryidx,len);
+    end;
+
+
+  function tentryfile.getbyte:byte;
+    begin
+      if entryidx+1>entry.size then
+       begin
+         error:=true;
+         result:=0;
+         exit;
+       end;
+      if bufsize-bufidx>=1 then
+        begin
+          result:=pbyte(@buf[bufidx])^;
+          inc(bufidx);
+        end
+      else
+        readdata(result,1);
+      inc(entryidx);
+    end;
+
+
+  function tentryfile.getword:word;
+    begin
+      if entryidx+2>entry.size then
+       begin
+         error:=true;
+         result:=0;
+         exit;
+       end;
+      if bufsize-bufidx>=sizeof(word) then
+        begin
+          result:=Unaligned(pword(@buf[bufidx])^);
+          inc(bufidx,sizeof(word));
+        end
+      else
+        readdata(result,sizeof(word));
+      if change_endian then
+       result:=swapendian(result);
+      inc(entryidx,2);
+    end;
+
+
+  function tentryfile.getlongint:longint;
+    begin
+      if entryidx+4>entry.size then
+       begin
+         error:=true;
+         result:=0;
+         exit;
+       end;
+      if bufsize-bufidx>=sizeof(longint) then
+        begin
+          result:=Unaligned(plongint(@buf[bufidx])^);
+          inc(bufidx,sizeof(longint));
+        end
+      else
+        readdata(result,sizeof(longint));
+      if change_endian then
+       result:=swapendian(result);
+      inc(entryidx,4);
+    end;
+
+
+  function tentryfile.getdword:dword;
+    begin
+      if entryidx+4>entry.size then
+       begin
+         error:=true;
+         result:=0;
+         exit;
+       end;
+      if bufsize-bufidx>=sizeof(dword) then
+        begin
+          result:=Unaligned(plongint(@buf[bufidx])^);
+          inc(bufidx,sizeof(longint));
+        end
+      else
+        readdata(result,sizeof(dword));
+      if change_endian then
+       result:=swapendian(result);
+      inc(entryidx,4);
+    end;
+
+
+  function tentryfile.getint64:int64;
+    begin
+      if entryidx+8>entry.size then
+       begin
+         error:=true;
+         result:=0;
+         exit;
+       end;
+      if bufsize-bufidx>=sizeof(int64) then
+        begin
+          result:=Unaligned(pint64(@buf[bufidx])^);
+          inc(bufidx,sizeof(int64));
+        end
+      else
+        readdata(result,sizeof(int64));
+      if change_endian then
+       result:=swapendian(result);
+      inc(entryidx,8);
+    end;
+
+
+  function tentryfile.getqword:qword;
+    begin
+      if entryidx+8>entry.size then
+       begin
+         error:=true;
+         result:=0;
+         exit;
+       end;
+      if bufsize-bufidx>=sizeof(qword) then
+        begin
+          result:=Unaligned(pqword(@buf[bufidx])^);
+          inc(bufidx,sizeof(qword));
+        end
+      else
+        readdata(result,sizeof(qword));
+      if change_endian then
+       result:=swapendian(result);
+      inc(entryidx,8);
+    end;
+
+
+  function tentryfile.getaint:aint;
+{$ifdef generic_cpu}
+  var
+    header : pentryheader;
+{$endif generic_cpu}
+  begin
+{$ifdef generic_cpu}
+      header:=getheaderaddr;
+      if CpuAluBitSize[tsystemcpu(header^.cpu)]=64 then
+        result:=getint64
+      else if CpuAluBitSize[tsystemcpu(header^.cpu)]=32 then
+        result:=getlongint
+      else if CpuAluBitSize[tsystemcpu(header^.cpu)]=16 then
+        result:=smallint(getword)
+      else if CpuAluBitSize[tsystemcpu(header^.cpu)]=8 then
+        result:=shortint(getbyte)
+      else
+        begin
+          error:=true;
+          result:=0;
+        end;
+{$else not generic_cpu}
+      case sizeof(aint) of
+        8: result:=getint64;
+        4: result:=getlongint;
+        2: result:=smallint(getword);
+        1: result:=shortint(getbyte);
+      end;
+{$endif not generic_cpu}
+    end;
+
+
+  function tentryfile.getasizeint:asizeint;
+{$ifdef generic_cpu}
+    var
+      header : pentryheader;
+{$endif generic_cpu}
+    begin
+{$ifdef generic_cpu}
+      header:=getheaderaddr;
+      if CpuAddrBitSize[tsystemcpu(header^.cpu)]=64 then
+        result:=getint64
+      else if CpuAddrBitSize[tsystemcpu(header^.cpu)]=32 then
+        result:=getlongint
+      else if CpuAddrBitSize[tsystemcpu(header^.cpu)]=16 then
+        result:=smallint(getword)
+      else
+        begin
+          error:=true;
+          result:=0;
+        end;
+{$else not generic_cpu}
+{$if defined(cpu64bitaddr)}
+      result:=getint64;
+{$elseif defined(cpu32bitaddr)}
+      result:=getlongint;
+{$elseif defined(cpu16bitaddr)}
+      result:=getword;
+{$endif}
+{$endif not generic_cpu}
+    end;
+
+
+  function tentryfile.getaword:aword;
+{$ifdef generic_cpu}
+    var
+      header : pentryheader;
+{$endif generic_cpu}
+    begin
+{$ifdef generic_cpu}
+      if CpuAluBitSize[tsystemcpu(header^.cpu)]=64 then
+        result:=getqword
+      else if CpuAluBitSize[tsystemcpu(header^.cpu)]=32 then
+        result:=getdword
+      else if CpuAluBitSize[tsystemcpu(header^.cpu)]=16 then
+        result:=getword
+      else if CpuAluBitSize[tsystemcpu(header^.cpu)]=8 then
+        result:=getbyte
+      else
+        begin
+          error:=true;
+          result:=0;
+        end;
+{$else not generic_cpu}
+{$ifdef cpu64bitalu}
+      result:=getqword;
+{$else cpu64bitalu}
+      result:=getdword;
+{$endif cpu64bitalu}
+{$endif not generic_cpu}
+    end;
+
+  function tentryfile.getrealsize(sizeofreal : longint):entryreal;
+    var
+      e : entryreal;
+      d : double;
+      s : single;
+    begin
+      if sizeofreal=sizeof(e) then
+        begin
+          if entryidx+sizeof(e)>entry.size then
+           begin
+             error:=true;
+             result:=0;
+             exit;
+           end;
+          readdata(e,sizeof(e));
+          if change_endian then
+            result:=swapendian_entryreal(e)
+          else
+            result:=e;
+          inc(entryidx,sizeof(e));
+          exit;
+        end;
+      if sizeofreal=sizeof(d) then
+        begin
+          if entryidx+sizeof(d)>entry.size then
+           begin
+             error:=true;
+             result:=0;
+             exit;
+           end;
+          readdata(d,sizeof(d));
+          if change_endian then
+            result:=swapendian(pqword(@d)^)
+          else
+            result:=d;
+          inc(entryidx,sizeof(d));
+          result:=d;
+          exit;
+        end;
+      if sizeofreal=sizeof(s) then
+        begin
+          if entryidx+sizeof(s)>entry.size then
+           begin
+             error:=true;
+             result:=0;
+             exit;
+           end;
+          readdata(s,sizeof(s));
+          if change_endian then
+            result:=swapendian(pdword(@s)^)
+          else
+            result:=s;
+          inc(entryidx,sizeof(s));
+          result:=s;
+          exit;
+        end;
+      error:=true;
+      result:=0.0;
+    end;
+
+
+  function tentryfile.getreal:entryreal;
+    var
+      d : entryreal;
+      hd : double;
+    begin
+      if target_info.system=system_x86_64_win64 then
+        begin
+          hd:=getrealsize(sizeof(hd));
+          getreal:=hd;
+        end
+      else
+        begin
+          d:=getrealsize(sizeof(d));
+          getreal:=d;
+        end;
+    end;
+
+
+  function tentryfile.getstring:string;
+    begin
+      result[0]:=chr(getbyte);
+      if entryidx+length(result)>entry.size then
+       begin
+         error:=true;
+         exit;
+       end;
+      ReadData(result[1],length(result));
+      inc(entryidx,length(result));
+    end;
+
+
+  function tentryfile.getansistring:ansistring;
+    var
+      len: longint;
+    begin
+      len:=getlongint;
+      if entryidx+len>entry.size then
+       begin
+         error:=true;
+         exit;
+       end;
+      setlength(result,len);
+      if len>0 then
+        getdata(result[1],len);
+    end;
+
+
+  procedure tentryfile.getsmallset(out b);
+    var
+      i : longint;
+    begin
+      getdata(b,4);
+      if change_endian then
+        for i:=0 to 3 do
+          Pbyte(@b)[i]:=reverse_byte(Pbyte(@b)[i]);
+    end;
+
+
+  procedure tentryfile.getnormalset(out b);
+    var
+      i : longint;
+    begin
+      getdata(b,32);
+      if change_endian then
+        for i:=0 to 31 do
+          Pbyte(@b)[i]:=reverse_byte(Pbyte(@b)[i]);
+    end;
+
+
+  function tentryfile.skipuntilentry(untilb:byte):boolean;
+    var
+      b : byte;
+    begin
+      repeat
+        b:=readentry;
+      until (b in [ibend,iberror]) or ((b=untilb) and (entry.id=mainentryid));
+      skipuntilentry:=(b=untilb);
+    end;
+
+
+  {*****************************************************************************
+                                  tentryfile Writing
+  *****************************************************************************}
+
+  function tentryfile.createfile:boolean;
+    var
+      ok: boolean;
+    begin
+      createfile:=false;
+      if outputallowed then
+        begin
+          {$ifdef MACOS}
+          {FPas is FreePascal's creator code on MacOS. See systems/mac_crea.txt}
+          SetDefaultMacOSCreator('FPas');
+          SetDefaultMacOSFiletype('FPPU');
+          {$endif}
+          ok:=false;
+          try
+            f:=CFileStreamClass.Create(fname,fmCreate);
+            ok:=true;
+          except
+          end;
+          {$ifdef MACOS}
+          SetDefaultMacOSCreator('MPS ');
+          SetDefaultMacOSFiletype('TEXT');
+          {$endif}
+          if not ok then
+           exit;
+          mode:=2;
+          {write header for sure}
+          f.Write(getheaderaddr^,getheadersize);
+        end;
+      bufsize:=entryfilebufsize;
+      bufstart:=getheadersize;
+      bufidx:=0;
+    {reset}
+      resetfile;
+      error:=false;
+      size:=0;
+      entrytyp:=mainentryid;
+    {start}
+      newentry;
+      createfile:=true;
+    end;
+
+
+  procedure tentryfile.writebuf;
+    begin
+      if outputallowed and
+         (bufidx <> 0) then
+        f.Write(buf^,bufidx);
+      inc(bufstart,bufidx);
+      bufidx:=0;
+    end;
+
+
+  procedure tentryfile.writedata(const b;len:integer);
+    var
+      p   : pchar;
+      left,
+      idx : integer;
+    begin
+      if not outputallowed then
+        exit;
+      p:=pchar(@b);
+      idx:=0;
+      while len>0 do
+       begin
+         left:=bufsize-bufidx;
+         if len>left then
+          begin
+            move(p[idx],buf[bufidx],left);
+            dec(len,left);
+            inc(idx,left);
+            inc(bufidx,left);
+            writebuf;
+          end
+         else
+          begin
+            move(p[idx],buf[bufidx],len);
+            inc(bufidx,len);
+            exit;
+          end;
+       end;
+    end;
+
+
+  procedure tentryfile.newentry;
+    begin
+      with entry do
+       begin
+         id:=entrytyp;
+         nr:=ibend;
+         size:=0;
+       end;
+    {Reset Entry State}
+      entryidx:=0;
+      entrybufstart:=bufstart;
+      entrystart:=bufstart+bufidx;
+    {Alloc in buffer}
+      writedata(entry,sizeof(tentry));
+    end;
+
+
+  procedure tentryfile.writeentry(ibnr:byte);
+    var
+      opos : integer;
+    begin
+    {create entry}
+      entry.id:=entrytyp;
+      entry.nr:=ibnr;
+      entry.size:=entryidx;
+    {it's already been sent to disk ?}
+      if entrybufstart<>bufstart then
+       begin
+        if outputallowed then
+          begin
+          {flush to be sure}
+            WriteBuf;
+          {write entry}
+            opos:=f.Position;
+            f.Position:=entrystart;
+            f.write(entry,sizeof(tentry));
+            f.Position:=opos;
+          end;
+         entrybufstart:=bufstart;
+       end
+      else
+       move(entry,buf[entrystart-bufstart],sizeof(entry));
+    {Add New Entry, which is ibend by default}
+      entrystart:=bufstart+bufidx; {next entry position}
+      newentry;
+    end;
+
+
+  procedure tentryfile.putdata(const b;len:integer);
+  begin
+    if outputallowed then
+      writedata(b,len);
+    inc(entryidx,len);
+  end;
+
+
+  procedure tentryfile.putbyte(b:byte);
+    begin
+      putdata(b,1);
+    end;
+
+
+  procedure tentryfile.putword(w:word);
+    begin
+      putdata(w,2);
+    end;
+
+
+  procedure tentryfile.putdword(w:dword);
+    begin
+      putdata(w,4);
+    end;
+
+
+  procedure tentryfile.putlongint(l:longint);
+    begin
+      putdata(l,4);
+    end;
+
+
+  procedure tentryfile.putint64(i:int64);
+    begin
+      putdata(i,8);
+    end;
+
+
+  procedure tentryfile.putqword(q:qword);
+    begin
+      putdata(q,sizeof(qword));
+    end;
+
+
+  procedure tentryfile.putaint(i:aint);
+    begin
+      putdata(i,sizeof(aint));
+    end;
+
+
+  procedure tentryfile.putasizeint(i: asizeint);
+    begin
+      putdata(i,sizeof(asizeint));
+    end;
+
+
+  procedure tentryfile.putaword(i:aword);
+    begin
+      putdata(i,sizeof(aword));
+    end;
+
+
+  procedure tentryfile.putreal(d:entryreal);
+    var
+      hd : double;
+    begin
+      if target_info.system=system_x86_64_win64 then
+        begin
+          hd:=d;
+          putdata(hd,sizeof(hd));
+        end
+      else
+        putdata(d,sizeof(entryreal));
+    end;
+
+
+  procedure tentryfile.putstring(const s:string);
+    begin
+      putdata(s,length(s)+1);
+    end;
+
+
+  procedure tentryfile.putansistring(const s:ansistring);
+    var
+      len: longint;
+    begin
+      len:=length(s);
+      putlongint(len);
+      if len>0 then
+        putdata(s[1],len);
+    end;
+
+
+  procedure tentryfile.putsmallset(const b);
+    var
+      l : longint;
+    begin
+      l:=longint(b);
+      putlongint(l);
+    end;
+
+
+  procedure tentryfile.putnormalset(const b);
+    begin
+      putdata(b,32);
+    end;
+
+
+  procedure tentryfile.tempclose;
+    begin
+      if not closed then
+       begin
+         closepos:=f.Position;
+         f.Free;
+         f:=nil;
+         closed:=true;
+         tempclosed:=true;
+       end;
+    end;
+
+
+  function tentryfile.tempopen:boolean;
+    begin
+      tempopen:=false;
+      if not closed or not tempclosed then
+       exit;
+     { MG: not sure, if this is correct
+       f.position:=0;
+         No, f was freed in tempclose above, we need to
+         recreate it.  PM 2011/06/06 }
+      try
+        f:=CFileStreamClass.Create(fname,fmOpenRead);
+      except
+        exit;
+      end;
+      closed:=false;
+      tempclosed:=false;
+
+    { restore state }
+      f.Position:=closepos;
+      tempopen:=true;
+    end;
+
+end.
+

+ 21 - 20
compiler/fppu.pas

@@ -116,7 +116,8 @@ uses
   scanner,
   scanner,
   aasmbase,ogbase,
   aasmbase,ogbase,
   parser,
   parser,
-  comphook;
+  comphook,
+  entfile;
 
 
 
 
 var
 var
@@ -215,7 +216,7 @@ var
            exit;
            exit;
          end;
          end;
       { check the target processor }
       { check the target processor }
-        if tsystemcpu(ppufile.header.cpu)<>target_cpu then
+        if tsystemcpu(ppufile.header.common.cpu)<>target_cpu then
          begin
          begin
            ppufile.free;
            ppufile.free;
            ppufile:=nil;
            ppufile:=nil;
@@ -223,7 +224,7 @@ var
            exit;
            exit;
          end;
          end;
       { check target }
       { check target }
-        if tsystem(ppufile.header.target)<>target_info.system then
+        if tsystem(ppufile.header.common.target)<>target_info.system then
          begin
          begin
            ppufile.free;
            ppufile.free;
            ppufile:=nil;
            ppufile:=nil;
@@ -232,7 +233,7 @@ var
          end;
          end;
 {$ifdef i8086}
 {$ifdef i8086}
       { check i8086 memory model flags }
       { check i8086 memory model flags }
-        if ((ppufile.header.flags and uf_i8086_far_code)<>0) xor
+        if ((ppufile.header.common.flags and uf_i8086_far_code)<>0) xor
             (current_settings.x86memorymodel in [mm_medium,mm_large,mm_huge]) then
             (current_settings.x86memorymodel in [mm_medium,mm_large,mm_huge]) then
          begin
          begin
            ppufile.free;
            ppufile.free;
@@ -240,7 +241,7 @@ var
            Message(unit_u_ppu_invalid_memory_model,@queuecomment);
            Message(unit_u_ppu_invalid_memory_model,@queuecomment);
            exit;
            exit;
          end;
          end;
-        if ((ppufile.header.flags and uf_i8086_far_data)<>0) xor
+        if ((ppufile.header.common.flags and uf_i8086_far_data)<>0) xor
             (current_settings.x86memorymodel in [mm_compact,mm_large]) then
             (current_settings.x86memorymodel in [mm_compact,mm_large]) then
          begin
          begin
            ppufile.free;
            ppufile.free;
@@ -248,7 +249,7 @@ var
            Message(unit_u_ppu_invalid_memory_model,@queuecomment);
            Message(unit_u_ppu_invalid_memory_model,@queuecomment);
            exit;
            exit;
          end;
          end;
-        if ((ppufile.header.flags and uf_i8086_huge_data)<>0) xor
+        if ((ppufile.header.common.flags and uf_i8086_huge_data)<>0) xor
             (current_settings.x86memorymodel=mm_huge) then
             (current_settings.x86memorymodel=mm_huge) then
          begin
          begin
            ppufile.free;
            ppufile.free;
@@ -256,7 +257,7 @@ var
            Message(unit_u_ppu_invalid_memory_model,@queuecomment);
            Message(unit_u_ppu_invalid_memory_model,@queuecomment);
            exit;
            exit;
          end;
          end;
-        if ((ppufile.header.flags and uf_i8086_cs_equals_ds)<>0) xor
+        if ((ppufile.header.common.flags and uf_i8086_cs_equals_ds)<>0) xor
             (current_settings.x86memorymodel=mm_tiny) then
             (current_settings.x86memorymodel=mm_tiny) then
          begin
          begin
            ppufile.free;
            ppufile.free;
@@ -268,7 +269,7 @@ var
 {$ifdef cpufpemu}
 {$ifdef cpufpemu}
        { check if floating point emulation is on?
        { check if floating point emulation is on?
          fpu emulation isn't unit levelwise because it affects calling convention }
          fpu emulation isn't unit levelwise because it affects calling convention }
-       if ((ppufile.header.flags and uf_fpu_emulation)<>0) xor
+       if ((ppufile.header.common.flags and uf_fpu_emulation)<>0) xor
             (cs_fp_emulation in current_settings.moduleswitches) then
             (cs_fp_emulation in current_settings.moduleswitches) then
          begin
          begin
            ppufile.free;
            ppufile.free;
@@ -279,7 +280,7 @@ var
 {$endif cpufpemu}
 {$endif cpufpemu}
 
 
       { Load values to be access easier }
       { Load values to be access easier }
-        flags:=ppufile.header.flags;
+        flags:=ppufile.header.common.flags;
         crc:=ppufile.header.checksum;
         crc:=ppufile.header.checksum;
         interface_crc:=ppufile.header.interface_checksum;
         interface_crc:=ppufile.header.interface_checksum;
         indirect_crc:=ppufile.header.indirect_checksum;
         indirect_crc:=ppufile.header.indirect_checksum;
@@ -1238,14 +1239,14 @@ var
          { flush to be sure }
          { flush to be sure }
          ppufile.flush;
          ppufile.flush;
          { create and write header }
          { create and write header }
-         ppufile.header.size:=ppufile.size;
+         ppufile.header.common.size:=ppufile.size;
          ppufile.header.checksum:=ppufile.crc;
          ppufile.header.checksum:=ppufile.crc;
          ppufile.header.interface_checksum:=ppufile.interface_crc;
          ppufile.header.interface_checksum:=ppufile.interface_crc;
          ppufile.header.indirect_checksum:=ppufile.indirect_crc;
          ppufile.header.indirect_checksum:=ppufile.indirect_crc;
-         ppufile.header.compiler:=wordversion;
-         ppufile.header.cpu:=word(target_cpu);
-         ppufile.header.target:=word(target_info.system);
-         ppufile.header.flags:=flags;
+         ppufile.header.common.compiler:=wordversion;
+         ppufile.header.common.cpu:=word(target_cpu);
+         ppufile.header.common.target:=word(target_info.system);
+         ppufile.header.common.flags:=flags;
          ppufile.header.deflistsize:=current_module.deflist.count;
          ppufile.header.deflistsize:=current_module.deflist.count;
          ppufile.header.symlistsize:=current_module.symlist.count;
          ppufile.header.symlistsize:=current_module.symlist.count;
          ppufile.writeheader;
          ppufile.writeheader;
@@ -1344,14 +1345,14 @@ var
 
 
          { create and write header, this will only be used
          { create and write header, this will only be used
            for debugging purposes }
            for debugging purposes }
-         ppufile.header.size:=ppufile.size;
+         ppufile.header.common.size:=ppufile.size;
          ppufile.header.checksum:=ppufile.crc;
          ppufile.header.checksum:=ppufile.crc;
          ppufile.header.interface_checksum:=ppufile.interface_crc;
          ppufile.header.interface_checksum:=ppufile.interface_crc;
          ppufile.header.indirect_checksum:=ppufile.indirect_crc;
          ppufile.header.indirect_checksum:=ppufile.indirect_crc;
-         ppufile.header.compiler:=wordversion;
-         ppufile.header.cpu:=word(target_cpu);
-         ppufile.header.target:=word(target_info.system);
-         ppufile.header.flags:=flags;
+         ppufile.header.common.compiler:=wordversion;
+         ppufile.header.common.cpu:=word(target_cpu);
+         ppufile.header.common.target:=word(target_info.system);
+         ppufile.header.common.flags:=flags;
          ppufile.writeheader;
          ppufile.writeheader;
 
 
          ppufile.closefile;
          ppufile.closefile;
@@ -1386,7 +1387,7 @@ var
               if (pu.u.interface_crc<>pu.interface_checksum) or
               if (pu.u.interface_crc<>pu.interface_checksum) or
                  (pu.u.indirect_crc<>pu.indirect_checksum) or
                  (pu.u.indirect_crc<>pu.indirect_checksum) or
                  (
                  (
-                  ((ppufile.header.flags and uf_release)=0) and
+                  ((ppufile.header.common.flags and uf_release)=0) and
                   (pu.u.crc<>pu.checksum)
                   (pu.u.crc<>pu.checksum)
                  ) then
                  ) then
                begin
                begin

+ 1 - 1
compiler/node.pas

@@ -495,7 +495,7 @@ interface
 implementation
 implementation
 
 
     uses
     uses
-       verbose,ppu,comphook,
+       verbose,entfile,comphook,
        symconst,
        symconst,
        nutils,nflw,
        nutils,nflw,
        defutil;
        defutil;

+ 8 - 8
compiler/pmodules.pas

@@ -41,7 +41,7 @@ implementation
        aasmtai,aasmdata,aasmcpu,aasmbase,
        aasmtai,aasmdata,aasmcpu,aasmbase,
        cgbase,cgobj,ngenutil,
        cgbase,cgobj,ngenutil,
        nbas,nutils,ncgutil,
        nbas,nutils,ncgutil,
-       link,assemble,import,export,gendef,ppu,comprsrc,dbgbase,
+       link,assemble,import,export,gendef,entfile,ppu,comprsrc,dbgbase,
        cresstr,procinfo,
        cresstr,procinfo,
        pexports,
        pexports,
        objcgutl,
        objcgutl,
@@ -1413,28 +1413,28 @@ type
            Exit;
            Exit;
          end;
          end;
       { No .o file generated for this ppu, just skip }
       { No .o file generated for this ppu, just skip }
-        if (inppu.header.flags and uf_no_link)<>0 then
+        if (inppu.header.common.flags and uf_no_link)<>0 then
          begin
          begin
            inppu.free;
            inppu.free;
            Result:=true;
            Result:=true;
            Exit;
            Exit;
          end;
          end;
       { Already a lib? }
       { Already a lib? }
-        if (inppu.header.flags and uf_in_library)<>0 then
+        if (inppu.header.common.flags and uf_in_library)<>0 then
          begin
          begin
            inppu.free;
            inppu.free;
            Comment(V_Error,'PPU is already in a library : '+PPUFn);
            Comment(V_Error,'PPU is already in a library : '+PPUFn);
            Exit;
            Exit;
          end;
          end;
       { We need a static linked unit }
       { We need a static linked unit }
-        if (inppu.header.flags and uf_static_linked)=0 then
+        if (inppu.header.common.flags and uf_static_linked)=0 then
          begin
          begin
            inppu.free;
            inppu.free;
            Comment(V_Error,'PPU is not static linked : '+PPUFn);
            Comment(V_Error,'PPU is not static linked : '+PPUFn);
            Exit;
            Exit;
          end;
          end;
       { Check if shared is allowed }
       { Check if shared is allowed }
-        if tsystem(inppu.header.target) in [system_i386_go32v2] then
+        if tsystem(inppu.header.common.target) in [system_i386_go32v2] then
          begin
          begin
            Comment(V_Error,'Shared library not supported for ppu target, switching to static library');
            Comment(V_Error,'Shared library not supported for ppu target, switching to static library');
            MakeStatic:=true;
            MakeStatic:=true;
@@ -1447,11 +1447,11 @@ type
         outppu.createfile;
         outppu.createfile;
       { Create new header, with the new flags }
       { Create new header, with the new flags }
         outppu.header:=inppu.header;
         outppu.header:=inppu.header;
-        outppu.header.flags:=outppu.header.flags or uf_in_library;
+        outppu.header.common.flags:=outppu.header.common.flags or uf_in_library;
         if MakeStatic then
         if MakeStatic then
-         outppu.header.flags:=outppu.header.flags or uf_static_linked
+         outppu.header.common.flags:=outppu.header.common.flags or uf_static_linked
         else
         else
-         outppu.header.flags:=outppu.header.flags or uf_shared_linked;
+         outppu.header.common.flags:=outppu.header.common.flags or uf_shared_linked;
       { read until the object files are found }
       { read until the object files are found }
         untilb:=iblinkunitofiles;
         untilb:=iblinkunitofiles;
         repeat
         repeat

File diff suppressed because it is too large
+ 42 - 803
compiler/ppu.pas


+ 2 - 1
compiler/symdef.pas

@@ -1131,7 +1131,8 @@ implementation
       fmodule,
       fmodule,
       { other }
       { other }
       gendef,
       gendef,
-      fpccrc
+      fpccrc,
+      entfile
       ;
       ;
 
 
 {****************************************************************************
 {****************************************************************************

+ 3 - 1
compiler/symsym.pas

@@ -475,7 +475,9 @@ implementation
        aasmtai,aasmdata,
        aasmtai,aasmdata,
        { codegen }
        { codegen }
        paramgr,
        paramgr,
-       procinfo
+       procinfo,
+       { ppu }
+       entfile
        ;
        ;
 
 
 {****************************************************************************
 {****************************************************************************

+ 4 - 4
compiler/symtable.pas

@@ -28,9 +28,7 @@ interface
        { common }
        { common }
        cutils,cclasses,globtype,tokens,
        cutils,cclasses,globtype,tokens,
        { symtable }
        { symtable }
-       symconst,symbase,symtype,symdef,symsym,
-       { ppu }
-       ppu;
+       symconst,symbase,symtype,symdef,symsym;
 
 
 
 
 {****************************************************************************
 {****************************************************************************
@@ -364,7 +362,9 @@ implementation
       { module }
       { module }
       fmodule,
       fmodule,
       { codegen }
       { codegen }
-      procinfo
+      procinfo,
+      { ppu }
+      entfile
       ;
       ;
 
 
 
 

+ 1 - 1
compiler/utils/ppufiles.pp

@@ -22,7 +22,7 @@ Program ppufiles;
 
 
 uses
 uses
   dos,
   dos,
-  ppu;
+  ppu,entfile;
 
 
 const
 const
   Version   = 'Version 1.00';
   Version   = 'Version 1.00';

+ 8 - 8
compiler/utils/ppumove.pp

@@ -39,7 +39,7 @@ uses
 {$else unix}
 {$else unix}
   dos,
   dos,
 {$endif unix}
 {$endif unix}
-  cutils,ppu,systems,
+  cutils,ppu,entfile,systems,
   getopts;
   getopts;
 
 
 const
 const
@@ -274,7 +274,7 @@ begin
      Exit;
      Exit;
    end;
    end;
 { No .o file generated for this ppu, just skip }
 { No .o file generated for this ppu, just skip }
-  if (inppu.header.flags and uf_no_link)<>0 then
+  if (inppu.header.common.flags and uf_no_link)<>0 then
    begin
    begin
      inppu.free;
      inppu.free;
      If Not Quiet then
      If Not Quiet then
@@ -283,21 +283,21 @@ begin
      Exit;
      Exit;
    end;
    end;
 { Already a lib? }
 { Already a lib? }
-  if (inppu.header.flags and uf_in_library)<>0 then
+  if (inppu.header.common.flags and uf_in_library)<>0 then
    begin
    begin
      inppu.free;
      inppu.free;
      Error('Error: PPU is already in a library : '+PPUFn,false);
      Error('Error: PPU is already in a library : '+PPUFn,false);
      Exit;
      Exit;
    end;
    end;
 { We need a static linked unit }
 { We need a static linked unit }
-  if (inppu.header.flags and uf_static_linked)=0 then
+  if (inppu.header.common.flags and uf_static_linked)=0 then
    begin
    begin
      inppu.free;
      inppu.free;
      Error('Error: PPU is not static linked : '+PPUFn,false);
      Error('Error: PPU is not static linked : '+PPUFn,false);
      Exit;
      Exit;
    end;
    end;
 { Check if shared is allowed }
 { Check if shared is allowed }
-  if tsystem(inppu.header.target) in [system_i386_go32v2] then
+  if tsystem(inppu.header.common.target) in [system_i386_go32v2] then
    begin
    begin
      Writeln('Warning: shared library not supported for ppu target, switching to static library');
      Writeln('Warning: shared library not supported for ppu target, switching to static library');
      MakeStatic:=true;
      MakeStatic:=true;
@@ -310,11 +310,11 @@ begin
   outppu.createfile;
   outppu.createfile;
 { Create new header, with the new flags }
 { Create new header, with the new flags }
   outppu.header:=inppu.header;
   outppu.header:=inppu.header;
-  outppu.header.flags:=outppu.header.flags or uf_in_library;
+  outppu.header.common.flags:=outppu.header.common.flags or uf_in_library;
   if MakeStatic then
   if MakeStatic then
-   outppu.header.flags:=outppu.header.flags or uf_static_linked
+   outppu.header.common.flags:=outppu.header.common.flags or uf_static_linked
   else
   else
-   outppu.header.flags:=outppu.header.flags or uf_shared_linked;
+   outppu.header.common.flags:=outppu.header.common.flags or uf_shared_linked;
 { read until the object files are found }
 { read until the object files are found }
   untilb:=iblinkunitofiles;
   untilb:=iblinkunitofiles;
   repeat
   repeat

+ 15 - 14
compiler/utils/ppuutils/ppudump.pp

@@ -31,6 +31,7 @@ uses
   constexp,
   constexp,
   symconst,
   symconst,
   ppu,
   ppu,
+  entfile,
   systems,
   systems,
   globals,
   globals,
   globtype,
   globtype,
@@ -2444,9 +2445,9 @@ begin
                toaddr :
                toaddr :
                  begin
                  begin
                    Write(['Address : ',getaword]);
                    Write(['Address : ',getaword]);
-                   if tsystemcpu(ppufile.header.cpu)=cpu_i386 then
+                   if tsystemcpu(ppufile.header.common.cpu)=cpu_i386 then
                      Write([' (Far: ',getbyte<>0,')']);
                      Write([' (Far: ',getbyte<>0,')']);
-                   if tsystemcpu(ppufile.header.cpu)=cpu_i8086 then
+                   if tsystemcpu(ppufile.header.common.cpu)=cpu_i8086 then
                      if getbyte<>0 then
                      if getbyte<>0 then
                        Write([' (Far: TRUE, Segment=',getaword,')'])
                        Write([' (Far: TRUE, Segment=',getaword,')'])
                      else
                      else
@@ -2653,7 +2654,7 @@ begin
              write  ([space,'     Pointed Type : ']);
              write  ([space,'     Pointed Type : ']);
              readderef('',TPpuPointerDef(def).Ptr);
              readderef('',TPpuPointerDef(def).Ptr);
              writeln([space,' Has Pointer Math : ',(getbyte<>0)]);
              writeln([space,' Has Pointer Math : ',(getbyte<>0)]);
-             if tsystemcpu(ppufile.header.cpu) in [cpu_i8086,cpu_i386,cpu_x86_64] then
+             if tsystemcpu(ppufile.header.common.cpu) in [cpu_i8086,cpu_i386,cpu_x86_64] then
                begin
                begin
                  write([space,' X86 Pointer Type : ']);
                  write([space,' X86 Pointer Type : ']);
                  b:=getbyte;
                  b:=getbyte;
@@ -2892,7 +2893,7 @@ begin
              write  ([space,'       SymOptions : ']);
              write  ([space,'       SymOptions : ']);
              readsymoptions(space+'       ');
              readsymoptions(space+'       ');
              writeln  ([space,'   Synthetic kind : ',Synthetic2Str(ppufile.getbyte)]);
              writeln  ([space,'   Synthetic kind : ',Synthetic2Str(ppufile.getbyte)]);
-             if tsystemcpu(ppufile.header.cpu)=cpu_powerpc then
+             if tsystemcpu(ppufile.header.common.cpu)=cpu_powerpc then
                begin
                begin
                  { library symbol for AmigaOS/MorphOS }
                  { library symbol for AmigaOS/MorphOS }
                  write  ([space,'   Library symbol : ']);
                  write  ([space,'   Library symbol : ']);
@@ -3527,13 +3528,13 @@ begin
      Writeln('-------');
      Writeln('-------');
      with ppufile.header do
      with ppufile.header do
       begin
       begin
-        Writeln(['Compiler version        : ',ppufile.header.compiler shr 14,'.',
-                                             (ppufile.header.compiler shr 7) and $7f,'.',
-                                             ppufile.header.compiler and $7f]);
-        WriteLn(['Target processor        : ',Cpu2Str(cpu)]);
-        WriteLn(['Target operating system : ',Target2Str(target)]);
-        Writeln(['Unit flags              : ',PPUFlags2Str(flags)]);
-        Writeln(['FileSize (w/o header)   : ',size]);
+        Writeln(['Compiler version        : ',ppufile.header.common.compiler shr 14,'.',
+                                             (ppufile.header.common.compiler shr 7) and $7f,'.',
+                                             ppufile.header.common.compiler and $7f]);
+        WriteLn(['Target processor        : ',Cpu2Str(common.cpu)]);
+        WriteLn(['Target operating system : ',Target2Str(common.target)]);
+        Writeln(['Unit flags              : ',PPUFlags2Str(common.flags)]);
+        Writeln(['FileSize (w/o header)   : ',common.size]);
         Writeln(['Checksum                : ',hexstr(checksum,8)]);
         Writeln(['Checksum                : ',hexstr(checksum,8)]);
         Writeln(['Interface Checksum      : ',hexstr(interface_checksum,8)]);
         Writeln(['Interface Checksum      : ',hexstr(interface_checksum,8)]);
         Writeln(['Indirect Checksum       : ',hexstr(indirect_checksum,8)]);
         Writeln(['Indirect Checksum       : ',hexstr(indirect_checksum,8)]);
@@ -3546,8 +3547,8 @@ begin
     begin
     begin
       CurUnit.Crc:=checksum;
       CurUnit.Crc:=checksum;
       CurUnit.IntfCrc:=interface_checksum;
       CurUnit.IntfCrc:=interface_checksum;
-      CurUnit.TargetCPU:=Cpu2Str(cpu);
-      CurUnit.TargetOS:=Target2Str(target);
+      CurUnit.TargetCPU:=Cpu2Str(common.cpu);
+      CurUnit.TargetOS:=Target2Str(common.target);
     end;
     end;
 
 
 {read the general stuff}
 {read the general stuff}
@@ -3626,7 +3627,7 @@ begin
   Writeln('Implementation symtable');
   Writeln('Implementation symtable');
   Writeln('----------------------');
   Writeln('----------------------');
   readsymtableoptions('implementation');
   readsymtableoptions('implementation');
-  if (ppufile.header.flags and uf_local_symtable)<>0 then
+  if (ppufile.header.common.flags and uf_local_symtable)<>0 then
    begin
    begin
      if (verbose and v_defs)<>0 then
      if (verbose and v_defs)<>0 then
       begin
       begin

+ 2 - 1
compiler/wpoinfo.pas

@@ -73,7 +73,8 @@ implementation
   uses
   uses
     globals,
     globals,
     symdef,
     symdef,
-    verbose;
+    verbose,
+    entfile;
 
 
   procedure tunitwpoinfo.clearderefinfo;
   procedure tunitwpoinfo.clearderefinfo;
     begin
     begin

Some files were not shown because too many files changed in this diff