Merged revision(s) 28689 from branches/svenbarth/packages:

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: trunk@32976 -

.gitattributes

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

compiler/entfile.pas

@@ -0,0 +1,1150 @@
+{
+    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'},
+    { 16 } 64 {'aarch64'}
+    );
+  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'},
+    { 16 } 64 {'aarch64'}
+    );
+{$endif generic_cpu}
+
+type
+  { bestreal is defined based on the target architecture }
+  entryreal=bestreal;
+
+
+
+  { 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;
+
+  tentry=packed record
+    size : longint;
+    id   : byte;
+    nr   : byte;
+  end;
+
+  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:{$ifdef generic_cpu}int64{$else}aint{$endif};
+    function getasizeint:{$ifdef generic_cpu}int64{$else}asizeint{$endif};
+    function getaword:{$ifdef generic_cpu}qword{$else}aword{$endif};
+    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:{$ifdef generic_cpu}int64{$else}aint{$endif};
+{$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}
+  result:=4;
+  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:{$ifdef generic_cpu}int64{$else}asizeint{$endif};
+{$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}
+  case sizeof(asizeint) of
+    8: result:=asizeint(getint64);
+    4: result:=asizeint(getlongint);
+    2: result:=asizeint(getword);
+    1: result:=asizeint(getbyte);
+    else
+      result:=0;
+end;
+{$endif not generic_cpu}
+end;
+
+
+function tentryfile.getaword:{$ifdef generic_cpu}qword{$else}aword{$endif};
+{$ifdef generic_cpu}
+var
+header : pentryheader;
+{$endif generic_cpu}
+begin
+{$ifdef generic_cpu}
+  header:=getheaderaddr;
+  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}
+  result:=4;
+  case sizeof(aword) of
+    8: result:=getqword;
+    4: result:=getdword;
+    2: result:=getword;
+    1: result:=getbyte;
+  end;
+{$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;
+     result:='';
+     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.

compiler/fppu.pas

@@ -118,7 +118,8 @@ uses
   scanner,
   aasmbase,ogbase,
   parser,
-  comphook;
+  comphook,
+  entfile;
 
 
 var
@@ -217,7 +218,7 @@ var
            exit;
          end;
       { check the target processor }
-        if tsystemcpu(ppufile.header.cpu)<>target_cpu then
+        if tsystemcpu(ppufile.header.common.cpu)<>target_cpu then
          begin
            ppufile.free;
            ppufile:=nil;
@@ -225,7 +226,7 @@ var
            exit;
          end;
       { check target }
-        if tsystem(ppufile.header.target)<>target_info.system then
+        if tsystem(ppufile.header.common.target)<>target_info.system then
          begin
            ppufile.free;
            ppufile:=nil;
@@ -234,7 +235,7 @@ var
          end;
 {$ifdef i8086}
       { 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
          begin
            ppufile.free;
@@ -242,7 +243,7 @@ var
            Message(unit_u_ppu_invalid_memory_model,@queuecomment);
            exit;
          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
          begin
            ppufile.free;
@@ -250,7 +251,7 @@ var
            Message(unit_u_ppu_invalid_memory_model,@queuecomment);
            exit;
          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
          begin
            ppufile.free;
@@ -258,7 +259,7 @@ var
            Message(unit_u_ppu_invalid_memory_model,@queuecomment);
            exit;
          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
          begin
            ppufile.free;
@@ -270,7 +271,7 @@ var
 {$ifdef cpufpemu}
        { check if floating point emulation is on?
          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
          begin
            ppufile.free;
@@ -281,7 +282,7 @@ var
 {$endif cpufpemu}
 
       { Load values to be access easier }
-        flags:=ppufile.header.flags;
+        flags:=ppufile.header.common.flags;
         crc:=ppufile.header.checksum;
         interface_crc:=ppufile.header.interface_checksum;
         indirect_crc:=ppufile.header.indirect_checksum;
@@ -1243,14 +1244,14 @@ var
          { flush to be sure }
          ppufile.flush;
          { create and write header }
-         ppufile.header.size:=ppufile.size;
+         ppufile.header.common.size:=ppufile.size;
          ppufile.header.checksum:=ppufile.crc;
          ppufile.header.interface_checksum:=ppufile.interface_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.symlistsize:=current_module.symlist.count;
          ppufile.writeheader;
@@ -1349,14 +1350,14 @@ var
 
          { create and write header, this will only be used
            for debugging purposes }
-         ppufile.header.size:=ppufile.size;
+         ppufile.header.common.size:=ppufile.size;
          ppufile.header.checksum:=ppufile.crc;
          ppufile.header.interface_checksum:=ppufile.interface_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.closefile;
@@ -1391,7 +1392,7 @@ var
               if (pu.u.interface_crc<>pu.interface_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)
                  ) then
                begin

compiler/node.pas

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

compiler/pmodules.pas

@@ -41,7 +41,7 @@ implementation
        aasmtai,aasmdata,aasmcpu,aasmbase,
        cgbase,cgobj,ngenutil,
        nbas,nutils,ncgutil,
-       link,assemble,import,export,gendef,ppu,comprsrc,dbgbase,
+       link,assemble,import,export,gendef,entfile,ppu,comprsrc,dbgbase,
        cresstr,procinfo,
        pexports,
        objcgutl,
@@ -1475,28 +1475,28 @@ type
            Exit;
          end;
       { 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
            inppu.free;
            Result:=true;
            Exit;
          end;
       { 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
            inppu.free;
            Comment(V_Error,'PPU is already in a library : '+PPUFn);
            Exit;
          end;
       { 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
            inppu.free;
            Comment(V_Error,'PPU is not static linked : '+PPUFn);
            Exit;
          end;
       { 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
            Comment(V_Error,'Shared library not supported for ppu target, switching to static library');
            MakeStatic:=true;
@@ -1509,11 +1509,11 @@ type
         outppu.createfile;
       { Create new header, with the new flags }
         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
-         outppu.header.flags:=outppu.header.flags or uf_static_linked
+         outppu.header.common.flags:=outppu.header.common.flags or uf_static_linked
         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 }
         untilb:=iblinkunitofiles;
         repeat

compiler/symdef.pas

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

compiler/symsym.pas

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

compiler/symtable.pas

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

compiler/utils/ppufiles.pp

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

compiler/utils/ppumove.pp

@@ -39,7 +39,7 @@ uses
 {$else unix}
   dos,
 {$endif unix}
-  cutils,ppu,systems,
+  cutils,ppu,entfile,systems,
   getopts;
 
 const
@@ -274,7 +274,7 @@ begin
      Exit;
    end;
 { 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
      inppu.free;
      If Not Quiet then
@@ -283,21 +283,21 @@ begin
      Exit;
    end;
 { 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
      inppu.free;
      Error('Error: PPU is already in a library : '+PPUFn,false);
      Exit;
    end;
 { 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
      inppu.free;
      Error('Error: PPU is not static linked : '+PPUFn,false);
      Exit;
    end;
 { 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
      Writeln('Warning: shared library not supported for ppu target, switching to static library');
      MakeStatic:=true;
@@ -310,11 +310,11 @@ begin
   outppu.createfile;
 { Create new header, with the new flags }
   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
-   outppu.header.flags:=outppu.header.flags or uf_static_linked
+   outppu.header.common.flags:=outppu.header.common.flags or uf_static_linked
   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 }
   untilb:=iblinkunitofiles;
   repeat

compiler/utils/ppuutils/ppudump.pp

@@ -31,6 +31,7 @@ uses
   constexp,
   symconst,
   ppu,
+  entfile,
   systems,
   globals,
   globtype,
@@ -2555,9 +2556,9 @@ begin
                toaddr :
                  begin
                    Write(['Address : ',getaword]);
-                   if tsystemcpu(ppufile.header.cpu)=cpu_i386 then
+                   if tsystemcpu(ppufile.header.common.cpu)=cpu_i386 then
                      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
                        Write([' (Far: TRUE, Segment=',getaword,')'])
                      else
@@ -2585,7 +2586,7 @@ begin
              write  ([space,' DefaultConst : ']);
              readderef('');
              if (vo_has_mangledname in varoptions) then
-               if tsystemcpu(ppufile.header.cpu)=cpu_jvm then
+               if tsystemcpu(ppufile.header.common.cpu)=cpu_jvm then
                  writeln([space,'AMangledname : ',getansistring])
                else
                  writeln([space,'SMangledname : ',getstring]);
@@ -2765,7 +2766,7 @@ begin
              write  ([space,'     Pointed Type : ']);
              readderef('',TPpuPointerDef(def).Ptr);
              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
                  write([space,' X86 Pointer Type : ']);
                  b:=getbyte;
@@ -2989,7 +2990,7 @@ begin
              writeln([space,'            Range : ',arrdef.RangeLow,' to ',arrdef.RangeHigh]);
              write  ([space,'          Options : ']);
              readarraydefoptions(arrdef);
-             if tsystemcpu(ppufile.header.cpu)=cpu_i8086 then
+             if tsystemcpu(ppufile.header.common.cpu)=cpu_i8086 then
                writeln([space,'             Huge : ',(getbyte<>0)]);
              readsymtable('symbols', arrdef);
            end;
@@ -3000,7 +3001,7 @@ begin
              readcommondef('Procedure definition',defoptions,def);
              read_abstract_proc_def(calloption,procoptions,TPpuProcDef(def));
              if (po_has_mangledname in procoptions) then
-               if tsystemcpu(ppufile.header.cpu)=cpu_jvm then
+               if tsystemcpu(ppufile.header.common.cpu)=cpu_jvm then
                  writeln([space,'     Mangled name : ',getansistring])
                else
                  writeln([space,'     Mangled name : ',getstring]);
@@ -3017,7 +3018,7 @@ begin
              write  ([space,'       SymOptions : ']);
              readsymoptions(space+'       ');
              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
                  { library symbol for AmigaOS/MorphOS }
                  write  ([space,'   Library symbol : ']);
@@ -3086,7 +3087,7 @@ begin
              { parast }
              readsymtable('parast',TPpuProcDef(def));
              delete(space,1,4);
-             if tsystemcpu(ppufile.header.cpu)=cpu_jvm then
+             if tsystemcpu(ppufile.header.common.cpu)=cpu_jvm then
                readderef('');
            end;
 
@@ -3342,7 +3343,7 @@ begin
                  readsymtable('elements',enumdef);
                  delete(space,1,4);
                end;
-             if tsystemcpu(ppufile.header.cpu)=cpu_jvm then
+             if tsystemcpu(ppufile.header.common.cpu)=cpu_jvm then
                begin
                  write([space,'        Class def : ']);
                  readderef('');
@@ -3681,13 +3682,13 @@ begin
      Writeln('-------');
      with ppufile.header do
       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(['Interface Checksum      : ',hexstr(interface_checksum,8)]);
         Writeln(['Indirect Checksum       : ',hexstr(indirect_checksum,8)]);
@@ -3700,8 +3701,8 @@ begin
     begin
       CurUnit.Crc:=checksum;
       CurUnit.IntfCrc:=interface_checksum;
-      CurUnit.TargetCPU:=Cpu2Str(cpu);
-      CurUnit.TargetOS:=Target2Str(target);
+      CurUnit.TargetCPU:=Cpu2Str(common.cpu);
+      CurUnit.TargetOS:=Target2Str(common.target);
     end;
 
 {read the general stuff}
@@ -3783,7 +3784,7 @@ begin
   Writeln('Implementation symtable');
   Writeln('----------------------');
   readsymtableoptions('implementation');
-  if (ppufile.header.flags and uf_local_symtable)<>0 then
+  if (ppufile.header.common.flags and uf_local_symtable)<>0 then
    begin
      if (verbose and v_defs)<>0 then
       begin

compiler/wpoinfo.pas

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