freepascal.compiler/compiler/ogbase.pas

{
    Copyright (c) 1998-2006 by Peter Vreman

    Contains the base stuff for binary object file writers

    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 ogbase;

{$i fpcdefs.inc}

interface

    uses
      { common }
      cclasses,
      { targets }
      systems,globtype,
      { outputwriters }
      owbase,
      { assembler }
      aasmbase;

    type
      TObjSection = class;
      TObjData = class;

      TExeSection = class;
      TExeSymbol  = class;

      TObjRelocationType = (
         { Relocation to absolute address }
         RELOC_ABSOLUTE,
{$ifdef x86_64}
         { 32bit Relocation to absolute address }
         RELOC_ABSOLUTE32,
         { 64 bit coff only }
         RELOC_RELATIVE_1,
         RELOC_RELATIVE_2,
         RELOC_RELATIVE_3,
         RELOC_RELATIVE_4,
         RELOC_RELATIVE_5,
{$endif x86_64}
{$ifdef arm}
         RELOC_RELATIVE_24,
         RELOC_NONE,
{$endif arm}
         { Relative relocation }
         RELOC_RELATIVE,
         { PECoff (Windows) RVA relocation }
         RELOC_RVA,
         { Generate a 0 value at the place of the relocation,
           this is used to remove unused vtable entries }
         RELOC_ZERO
      );

{$ifndef x86_64}
    const
      RELOC_ABSOLUTE32 = RELOC_ABSOLUTE;
{$endif x86_64}

    type
      TObjSectionOption = (
       { Has Data available in the file }
       oso_Data,
       { Is loaded into memory }
       oso_load,
       { Not loaded into memory }
       oso_noload,
       { Read only }
       oso_readonly,
       { Read/Write }
       oso_write,
       { Contains executable instructions }
       oso_executable,
       { Never discard section }
       oso_keep,
       { Special common symbols }
       oso_common,
       { Contains debug info and can be stripped }
       oso_debug,
       { Contains only strings }
       oso_strings
     );

     TObjSectionOptions = set of TObjSectionOption;

     TObjSymbol = class(TFPHashObject)
     public
       bind       : TAsmsymbind;
       typ        : TAsmsymtype;
       { Current assemble pass, used to detect duplicate labels }
       pass       : byte;
       objsection : TObjSection;
       symidx     : longint;
       offset,
       size       : aint;
       { Used for external and common solving during linking }
       exesymbol  : TExeSymbol;
       constructor create(AList:TFPHashObjectList;const AName:string);
       function  address:aint;
       procedure SetAddress(apass:byte;aobjsec:TObjSection;abind:TAsmsymbind;atyp:Tasmsymtype);
     end;

     { Stabs is common for all targets }
     TObjStabEntry=packed record
        strpos  : longint;
        ntype   : byte;
        nother  : byte;
        ndesc   : word;
        nvalue  : longint;
     end;
     PObjStabEntry=^TObjStabEntry;

     TObjRelocation = class
        DataOffset,
        orgsize    : aint;  { original size of the symbol to Relocate, required for COFF }
        symbol     : TObjSymbol;
        objsection : TObjSection; { only used if symbol=nil }
        typ        : TObjRelocationType;
        constructor CreateSymbol(ADataOffset:aint;s:TObjSymbol;Atyp:TObjRelocationType);
        constructor CreateSymbolSize(ADataOffset:aint;s:TObjSymbol;Aorgsize:aint;Atyp:TObjRelocationType);
        constructor CreateSection(ADataOffset:aint;aobjsec:TObjSection;Atyp:TObjRelocationType);
     end;

     TObjSection = class(TFPHashObject)
     private
       FData       : TDynamicArray;
       FSecOptions : TObjSectionOptions;
       procedure SetSecOptions(Aoptions:TObjSectionOptions);
     public
       ObjData    : TObjData;
       SecSymIdx  : longint;   { index for the section in symtab }
       SecAlign   : shortint;   { alignment of the section }
       { section Data }
       Size,
       DataPos,
       MemPos     : aint;
       DataAlignBytes : shortint;
       { Relocations (=references) to other sections }
       ObjRelocations : TFPObjectList;
       { Symbols this defines }
       ObjSymbolDefines : TFPObjectList;
       { executable linking }
       ExeSection  : TExeSection;
       Used       : boolean;
       VTRefList : TFPObjectList;
       constructor create(AList:TFPHashObjectList;const Aname:string;Aalign:shortint;Aoptions:TObjSectionOptions);virtual;
       destructor  destroy;override;
       function  write(const d;l:aint):aint;
       function  writestr(const s:string):aint;
       function  WriteZeros(l:longint):aint;
       procedure setmempos(var mpos:aint);
       procedure setDatapos(var dpos:aint);
       procedure alloc(l:aint);
       procedure addsymReloc(ofs:aint;p:TObjSymbol;Reloctype:TObjRelocationType);
       procedure addsectionReloc(ofs:aint;aobjsec:TObjSection;Reloctype:TObjRelocationType);
       procedure AddSymbolDefine(p:TObjSymbol);
       procedure FixupRelocs;virtual;
       procedure ReleaseData;
       function  FullName:string;
       property  Data:TDynamicArray read FData;
       property  SecOptions:TObjSectionOptions read FSecOptions write SetSecOptions;
     end;
     TObjSectionClass = class of TObjSection;

     TObjData = class(TLinkedListItem)
     private
       FName       : string[80];
       FCurrObjSec : TObjSection;
       FObjSectionList  : TFPHashObjectList;
       FCObjSection     : TObjSectionClass;
       { Symbols that will be defined in this object file }
       FObjSymbolList    : TFPHashObjectList;
       FCachedAsmSymbolList : TFPObjectList;
       { Special info sections that are written to during object generation }
       FStabsObjSec,
       FStabStrObjSec : TObjSection;
       procedure section_reset(p:TObject;arg:pointer);
       procedure section_afteralloc(p:TObject;arg:pointer);
       procedure section_afterwrite(p:TObject;arg:pointer);
     protected
       property StabsSec:TObjSection read FStabsObjSec write FStabsObjSec;
       property StabStrSec:TObjSection read FStabStrObjSec write FStabStrObjSec;
       property CObjSection:TObjSectionClass read FCObjSection write FCObjSection;
     public
       CurrPass  : byte;
       ImageBase : aint;
       constructor create(const n:string);virtual;
       destructor  destroy;override;
       { Sections }
       function  sectionname(atype:TAsmSectiontype;const aname:string):string;virtual;
       function  sectiontype2options(atype:TAsmSectiontype):TObjSectionOptions;virtual;
       function  sectiontype2align(atype:TAsmSectiontype):shortint;virtual;
       function  createsection(atype:TAsmSectionType;const aname:string):TObjSection;
       function  createsection(const aname:string;aalign:shortint;aoptions:TObjSectionOptions):TObjSection;virtual;
       procedure CreateDebugSections;virtual;
       function  findsection(const aname:string):TObjSection;
       procedure setsection(asec:TObjSection);
       { Symbols }
       function  createsymbol(const aname:string):TObjSymbol;
       function  symboldefine(asmsym:TAsmSymbol):TObjSymbol;
       function  symboldefine(const aname:string;abind:TAsmsymbind;atyp:Tasmsymtype):TObjSymbol;
       function  symbolref(asmsym:TAsmSymbol):TObjSymbol;
       function  symbolref(const aname:string):TObjSymbol;
       procedure ResetCachedAsmSymbols;
       { Allocation }
       procedure alloc(len:aint);
       procedure allocalign(len:shortint);
       procedure allocstab(p:pchar);
       procedure writebytes(const Data;len:aint);
       procedure writeReloc(Data,len:aint;p:TObjSymbol;Reloctype:TObjRelocationType);virtual;abstract;
       procedure writestab(offset:aint;ps:TObjSymbol;nidx,nother:byte;ndesc:word;p:pchar);virtual;abstract;
       procedure beforealloc;virtual;
       procedure beforewrite;virtual;
       procedure afteralloc;virtual;
       procedure afterwrite;virtual;
       procedure resetsections;
       property Name:string[80] read FName;
       property CurrObjSec:TObjSection read FCurrObjSec;
       property ObjSymbolList:TFPHashObjectList read FObjSymbolList;
       property ObjSectionList:TFPHashObjectList read FObjSectionList;
     end;
     TObjDataClass = class of TObjData;

     TObjOutput = class
      private
        FCObjData : TObjDataClass;
      protected
        { writer }
        FWriter    : TObjectwriter;
        function  writeData(Data:TObjData):boolean;virtual;abstract;
        property CObjData : TObjDataClass read FCObjData write FCObjData;
      public
        constructor create(AWriter:TObjectWriter);virtual;
        destructor  destroy;override;
        function  newObjData(const n:string):TObjData;
        function  startObjectfile(const fn:string):boolean;
        function  writeobjectfile(Data:TObjData):boolean;
        procedure exportsymbol(p:TObjSymbol);
        property Writer:TObjectWriter read FWriter;
      end;
      TObjOutputClass=class of TObjOutput;

      TObjInput = class
      private
        FCObjData : TObjDataClass;
      protected
        { reader }
        FReader    : TObjectreader;
        function  readObjData(Data:TObjData):boolean;virtual;abstract;
        property CObjData : TObjDataClass read FCObjData write FCObjData;
      public
        constructor create;virtual;
        destructor  destroy;override;
        function  newObjData(const n:string):TObjData;
        function  readobjectfile(const fn:string;Data:TObjData):boolean;virtual;
        property Reader:TObjectReader read FReader;
        procedure inputerror(const s : string);
      end;
      TObjInputClass=class of TObjInput;

      TVTableEntry=record
        ObjRelocation : TObjRelocation;
        orgreloctype  : TObjRelocationType;
        Enabled,
        Used  : Boolean;
      end;
      PVTableEntry=^TVTableEntry;

      TExeVTable = class
      private
        procedure CheckIdx(VTableIdx:longint);
      public
        ExeSymbol    : TExeSymbol;
        EntryCnt     : Longint;
        EntryArray   : PVTableEntry;
        Consolidated : Boolean;
        ChildList    : TFPObjectList;
        constructor Create(AExeSymbol:TExeSymbol);
        destructor Destroy;override;
        procedure AddChild(vt:TExeVTable);
        procedure AddEntry(VTableIdx:Longint);
        procedure SetVTableSize(ASize:longint);
        function  VTableRef(VTableIdx:Longint):TObjRelocation;
      end;

      TExeSymbol = class(TFPHashObject)
        ObjSymbol  : TObjSymbol;
        ExeSection : TExeSection;
        { Used for vmt references optimization }
        VTable     : TExeVTable;
      end;

      TExeSection = class(TFPHashObject)
      private
        FSecSymIdx : longint;
        FObjSectionList : TFPObjectList;
      public
        Size,
        DataPos,
        MemPos     : aint;
        SecAlign   : shortint;
        SecOptions : TObjSectionOptions;
        constructor create(AList:TFPHashObjectList;const AName:string);virtual;
        destructor  destroy;override;
        procedure AddObjSection(objsec:TObjSection);
        property ObjSectionList:TFPObjectList read FObjSectionList;
        property SecSymIdx:longint read FSecSymIdx write FSecSymIdx;
      end;
      TExeSectionClass=class of TExeSection;

      TExternalLibrary = class(TFPHashObject)
      private
        FExternalSymbolList : TFPHashObjectList;
      public
        constructor create(AList:TFPHashObjectList;const AName:string);virtual;
        destructor  destroy;override;
        property ExternalSymbolList:TFPHashObjectList read FExternalSymbolList;
      end;

      TExeOutput = class
      private
        { ExeSections }
        FCObjData         : TObjDataClass;
        FCExeSection      : TExeSectionClass;
        FCurrExeSec       : TExeSection;
        FExeSectionList   : TFPHashObjectList;
        Fzeronr           : longint;
        { Symbols }
        FExeSymbolList    : TFPHashObjectList;
        FUnresolvedExeSymbols : TFPObjectList;
        FExternalObjSymbols,
        FCommonObjSymbols   : TFPObjectList;
        FEntryName          : string;
        FExeVTableList     : TFPObjectList;
        { Objects }
        FObjDataList  : TFPObjectList;
        { Position calculation }
        FImageBase    : aint;
        FCurrDataPos,
        FCurrMemPos   : aint;
      protected
        { writer }
        FWriter : TObjectwriter;
        commonObjSection : TObjSection;
        internalObjData : TObjData;
        EntrySym  : TObjSymbol;
        SectionDataAlign,
        SectionMemAlign : aint;
        function  writeData:boolean;virtual;abstract;
        property CExeSection:TExeSectionClass read FCExeSection write FCExeSection;
        property CObjData:TObjDataClass read FCObjData write FCObjData;
      public
        IsSharedLibrary : boolean;
        constructor create;virtual;
        destructor  destroy;override;
        function  FindExeSection(const aname:string):TExeSection;
        procedure AddObjData(ObjData:TObjData);
        procedure Load_Start;virtual;
        procedure Load_EntryName(const aname:string);virtual;
        procedure Load_Symbol(const aname:string);virtual;
        procedure Load_IsSharedLibrary;
        procedure Load_ImageBase(const avalue:string);
        procedure Order_Start;virtual;
        procedure Order_End;virtual;
        procedure Order_ExeSection(const aname:string);virtual;
        procedure Order_Align(const aname:string);virtual;
        procedure Order_Zeros(const aname:string);virtual;
        procedure Order_Symbol(const aname:string);virtual;
        procedure Order_EndExeSection;virtual;
        procedure Order_ObjSection(const aname:string);virtual;
        procedure CalcPos_ExeSection(const aname:string);virtual;
        procedure CalcPos_EndExeSection;virtual;
        procedure CalcPos_Header;virtual;
        procedure CalcPos_Start;virtual;
        procedure CalcPos_Symbols;virtual;
        procedure BuildVTableTree(VTInheritList,VTEntryList:TFPObjectList);
        procedure ResolveSymbols;
        procedure PrintMemoryMap;
        procedure FixupSymbols;
        procedure FixupRelocations;
        procedure MergeStabs;
        procedure RemoveUnreferencedSections;
        procedure RemoveEmptySections;
        procedure GenerateLibraryImports(ExternalLibraryList:TFPHashObjectList);virtual;
        function  writeexefile(const fn:string):boolean;
        property Writer:TObjectWriter read FWriter;
        property ExeSections:TFPHashObjectList read FExeSectionList;
        property ObjDataList:TFPObjectList read FObjDataList;
        property ExeSymbolList:TFPHashObjectList read FExeSymbolList;
        property UnresolvedExeSymbols:TFPObjectList read FUnresolvedExeSymbols;
        property ExternalObjSymbols:TFPObjectList read FExternalObjSymbols;
        property CommonObjSymbols:TFPObjectList read FCommonObjSymbols;
        property ExeVTableList:TFPObjectList read FExeVTableList;
        property EntryName:string read FEntryName write FEntryName;
        property ImageBase:aint read FImageBase write FImageBase;
        property CurrExeSec:TExeSection read FCurrExeSec;
        property CurrDataPos:aint read FCurrDataPos write FCurrDataPos;
        property CurrMemPos:aint read FCurrMemPos write FCurrMemPos;
      end;
      TExeOutputClass=class of TExeOutput;

    var
      exeoutput : TExeOutput;


implementation

    uses
      cutils,globals,verbose,fmodule,ogmap;

    const
      sectionDatagrowsize = 256-sizeof(ptrint);

{$ifdef MEMDEBUG}
    var
      memobjsymbols,
      memobjsections : TMemDebug;
{$endif MEMDEBUG}

{*****************************************************************************
                                 TObjSymbol
*****************************************************************************}

    constructor TObjSymbol.create(AList:TFPHashObjectList;const AName:string);
      begin;
        inherited create(AList,AName);
        bind:=AB_EXTERNAL;
        typ:=AT_NONE;
        symidx:=-1;
        size:=0;
        offset:=0;
        objsection:=nil;
      end;


    function TObjSymbol.address:aint;
      begin
        if assigned(objsection) then
          result:=offset+objsection.mempos
        else
          result:=0;
      end;


    procedure TObjSymbol.SetAddress(apass:byte;aobjsec:TObjSection;abind:TAsmsymbind;atyp:Tasmsymtype);
      begin
        if not(abind in [AB_GLOBAL,AB_LOCAL,AB_COMMON]) then
          internalerror(200603016);
        if not assigned(aobjsec) then
          internalerror(200603017);
        if (bind=AB_EXTERNAL) then
          begin
            bind:=abind;
            typ:=atyp;
          end
        else
          begin
            if pass=apass then
              Message1(asmw_e_duplicate_label,name);
          end;
        pass:=apass;
        { Code can never grow after a pass }
        if assigned(objsection) and
           (aobjsec.size>offset) then
          internalerror(200603014);
        objsection:=aobjsec;
        offset:=aobjsec.size;
      end;

{****************************************************************************
                              TObjRelocation
****************************************************************************}

    constructor TObjRelocation.CreateSymbol(ADataOffset:aint;s:TObjSymbol;Atyp:TObjRelocationType);
      begin
        if not assigned(s) then
          internalerror(200603034);
        DataOffset:=ADataOffset;
        Symbol:=s;
        OrgSize:=0;
        ObjSection:=nil;
        Typ:=Atyp;
      end;


    constructor TObjRelocation.CreateSymbolSize(ADataOffset:aint;s:TObjSymbol;Aorgsize:aint;Atyp:TObjRelocationType);
      begin
        if not assigned(s) then
          internalerror(200603035);
        DataOffset:=ADataOffset;
        Symbol:=s;
        OrgSize:=Aorgsize;
        ObjSection:=nil;
        Typ:=Atyp;
      end;


    constructor TObjRelocation.CreateSection(ADataOffset:aint;aobjsec:TObjSection;Atyp:TObjRelocationType);
      begin
        if not assigned(aobjsec) then
          internalerror(200603036);
        DataOffset:=ADataOffset;
        Symbol:=nil;
        OrgSize:=0;
        ObjSection:=aobjsec;
        Typ:=Atyp;
      end;


{****************************************************************************
                              TObjSection
****************************************************************************}

    constructor TObjSection.create(AList:TFPHashObjectList;const Aname:string;Aalign:shortint;Aoptions:TObjSectionOptions);
      begin
        inherited Create(AList,Aname);
        { Data }
        Size:=0;
        Datapos:=0;
        mempos:=0;
        FData:=Nil;
        { Setting the secoptions allocates Data if needed }
        secoptions:=Aoptions;
        secalign:=Aalign;
        secsymidx:=0;
        { relocation }
        ObjRelocations:=TFPObjectList.Create(true);
        ObjSymbolDefines:=TFPObjectList.Create(false);
        VTRefList:=TFPObjectList.Create(false);
      end;


    destructor TObjSection.destroy;
      begin
        if assigned(Data) then
          Data.Free;
        ObjRelocations.Free;
        ObjSymbolDefines.Free;
        VTRefList.Free;
        inherited destroy;
      end;


    procedure TObjSection.SetSecOptions(Aoptions:TObjSectionOptions);
      begin
        FSecOptions:=FSecOptions+AOptions;
        if (oso_Data in secoptions) and
           not assigned(FData) then
          FData:=TDynamicArray.Create(sectionDatagrowsize);
      end;


    function TObjSection.write(const d;l:aint):aint;
      begin
        result:=size;
        if assigned(Data) then
          begin
            if Size<>Data.size then
              internalerror(200602281);
            Data.write(d,l);
            inc(Size,l);
          end
        else
          internalerror(200602289);
      end;


    function TObjSection.writestr(const s:string):aint;
      begin
        result:=Write(s[1],length(s));
      end;


    function TObjSection.WriteZeros(l:longint):aint;
      var
        empty : array[0..1023] of byte;
      begin
        if l>sizeof(empty) then
          internalerror(200404082);
        if l>0 then
          begin
            fillchar(empty,l,0);
            result:=Write(empty,l);
          end
        else
          result:=Size;
      end;


    procedure TObjSection.setDatapos(var dpos:aint);
      begin
        if oso_Data in secoptions then
          begin
            { get aligned Datapos }
            Datapos:=align(dpos,secalign);
            Dataalignbytes:=Datapos-dpos;
            { return updated Datapos }
            dpos:=Datapos+size;
          end
        else
          Datapos:=dpos;
      end;


    procedure TObjSection.setmempos(var mpos:aint);
      begin
        mempos:=align(mpos,secalign);
        { return updated mempos }
        mpos:=mempos+size;
      end;


    procedure TObjSection.alloc(l:aint);
      begin
        inc(size,l);
      end;


    procedure TObjSection.addsymReloc(ofs:aint;p:TObjSymbol;Reloctype:TObjRelocationType);
      begin
        ObjRelocations.Add(TObjRelocation.CreateSymbol(ofs,p,reloctype));
      end;


    procedure TObjSection.addsectionReloc(ofs:aint;aobjsec:TObjSection;Reloctype:TObjRelocationType);
      begin
        ObjRelocations.Add(TObjRelocation.CreateSection(ofs,aobjsec,reloctype));
      end;


    procedure TObjSection.AddSymbolDefine(p:TObjSymbol);
      begin
        if p.bind<>AB_GLOBAL then
          exit;
        ObjSymbolDefines.Add(p);
      end;


    procedure TObjSection.FixupRelocs;
      begin
      end;


    procedure TObjSection.ReleaseData;
      begin
        if assigned(FData) then
          begin
            FData.free;
            FData:=nil;
          end;
        ObjRelocations.free;
        ObjRelocations:=nil;
        ObjSymbolDefines.Free;
        ObjSymbolDefines:=nil;
      end;


    function  TObjSection.FullName:string;
      begin
        if assigned(ObjData) then
          result:=ObjData.Name+'('+Name+')'
        else
          result:=Name;
      end;


{****************************************************************************
                                TObjData
****************************************************************************}

    constructor TObjData.create(const n:string);
      begin
        inherited create;
        FName:=SplitFileName(n);
        FObjSectionList:=TFPHashObjectList.Create(true);
        FStabsObjSec:=nil;
        FStabStrObjSec:=nil;
        { symbols }
        FObjSymbolList:=TFPHashObjectList.Create(true);
        FCachedAsmSymbolList:=TFPObjectList.Create(false);
        { section class type for creating of new sections }
        FCObjSection:=TObjSection;
      end;


    destructor TObjData.destroy;
{$ifdef MEMDEBUG}
       var
         d : tmemdebug;
{$endif}
      begin
{$ifdef MEMDEBUG}
        d:=tmemdebug.create(name+' - ObjData symbols');
        MemObjSymbols.Start;
{$endif}
        ResetCachedAsmSymbols;
        FCachedAsmSymbolList.free;
        FObjSymbolList.free;
{$ifdef MEMDEBUG}
        MemObjSymbols.Stop;
        d.free;
{$endif}
{$ifdef MEMDEBUG}
        d:=tmemdebug.create(name+' - ObjData sections');
        MemObjSections.Start;
{$endif}
        FObjSectionList.free;
{$ifdef MEMDEBUG}
        MemObjSections.Stop;
        d.free;
{$endif}
        inherited destroy;
      end;


    function TObjData.sectionname(atype:TAsmSectiontype;const aname:string):string;
      const
        secnames : array[TAsmSectiontype] of string[16] = ('',
          'code',
          'Data',
          'roData',
          'bss',
          'threadvar',
          'stub',
          'stab','stabstr',
          'iData2','iData4','iData5','iData6','iData7','eData',
          'eh_frame',
          'debug_frame','debug_info','debug_line','debug_abbrev',
          'fpc',
          'toc'
        );
      begin
        if aname<>'' then
          result:=secnames[atype]+'.'+aname
        else
          result:=secnames[atype];
      end;


    function TObjData.sectiontype2options(atype:TAsmSectiontype):TObjSectionOptions;
      const
        secoptions : array[TAsmSectiontype] of TObjSectionOptions = ([],
          {code} [oso_Data,oso_load,oso_readonly,oso_executable,oso_keep],
          {Data} [oso_Data,oso_load,oso_write,oso_keep],
{$warning TODO Fix roData be read-only}
          {roData} [oso_Data,oso_load,oso_write,oso_keep],
          {bss} [oso_load,oso_write,oso_keep],
          {threadvar} [oso_load,oso_write],
          {stub} [oso_Data,oso_load,oso_readonly,oso_executable],
          {stab} [oso_Data,oso_noload,oso_debug],
          {stabstr} [oso_Data,oso_noload,oso_strings,oso_debug],
{$warning TODO iData keep can maybe replaced with grouping of text and iData}
          {iData2} [oso_Data,oso_load,oso_write,oso_keep],
          {iData4} [oso_Data,oso_load,oso_write,oso_keep],
          {iData5} [oso_Data,oso_load,oso_write,oso_keep],
          {iData6} [oso_Data,oso_load,oso_write,oso_keep],
          {iData7} [oso_Data,oso_load,oso_write,oso_keep],
          {eData} [oso_Data,oso_load,oso_readonly],
          {eh_frame} [oso_Data,oso_load,oso_readonly],
          {debug_frame} [oso_Data,oso_noload,oso_debug],
          {debug_info} [oso_Data,oso_noload,oso_debug],
          {debug_line} [oso_Data,oso_noload,oso_debug],
          {debug_abbrev} [oso_Data,oso_noload,oso_debug],
          {fpc} [oso_Data,oso_load,oso_write,oso_keep],
          {toc} [oso_Data,oso_load,oso_readonly]
        );
      begin
        result:=secoptions[atype];
      end;


    function TObjData.sectiontype2align(atype:TAsmSectiontype):shortint;
      begin
        case atype of
          sec_stabstr,sec_debug_info,sec_debug_line,sec_debug_abbrev:
            result:=1;
          sec_code,
          sec_bss,
          sec_data:
            result:=16;
          else
            result:=sizeof(aint);
        end;
      end;


    function TObjData.createsection(atype:TAsmSectionType;const aname:string):TObjSection;
      begin
        result:=createsection(sectionname(atype,aname),sectiontype2align(atype),sectiontype2options(atype));
      end;


    function TObjData.createsection(const aname:string;aalign:shortint;aoptions:TObjSectionOptions):TObjSection;
      begin
        result:=TObjSection(FObjSectionList.Find(aname));
        if not assigned(result) then
          begin
            result:=CObjSection.create(FObjSectionList,aname,aalign,aoptions);
            result.ObjData:=self;
          end;
        FCurrObjSec:=result;
      end;


    procedure TObjData.CreateDebugSections;
      begin
      end;


    function TObjData.FindSection(const aname:string):TObjSection;
      begin
        result:=TObjSection(FObjSectionList.Find(aname));
      end;


    procedure TObjData.setsection(asec:TObjSection);
      begin
        if asec.ObjData<>self then
          internalerror(200403041);
        FCurrObjSec:=asec;
      end;


    function TObjData.createsymbol(const aname:string):TObjSymbol;
      begin
        result:=TObjSymbol(FObjSymbolList.Find(aname));
        if not assigned(result) then
          result:=TObjSymbol.Create(FObjSymbolList,aname);
      end;


    function TObjData.symboldefine(asmsym:TAsmSymbol):TObjSymbol;
      begin
        if assigned(asmsym) then
          begin
            if not assigned(asmsym.cachedObjSymbol) then
              begin
                result:=symboldefine(asmsym.name,asmsym.bind,asmsym.typ);
                asmsym.cachedObjSymbol:=result;
                FCachedAsmSymbolList.add(asmsym);
              end
            else
              begin
                result:=TObjSymbol(asmsym.cachedObjSymbol);
                result.SetAddress(CurrPass,CurrObjSec,asmsym.bind,asmsym.typ);
                { Register also in TObjSection }
                CurrObjSec.AddSymbolDefine(result);
              end;
          end
        else
          result:=nil;
      end;


    function TObjData.symboldefine(const aname:string;abind:TAsmsymbind;atyp:Tasmsymtype):TObjSymbol;
      begin
        if not assigned(CurrObjSec) then
          internalerror(200603051);
        result:=CreateSymbol(aname);
        { Register also in TObjSection }
        CurrObjSec.AddSymbolDefine(result);
        result.SetAddress(CurrPass,CurrObjSec,abind,atyp);
      end;


    function TObjData.symbolref(asmsym:TAsmSymbol):TObjSymbol;
      begin
        if assigned(asmsym) then
          begin
            if not assigned(asmsym.cachedObjSymbol) then
              begin
                result:=symbolref(asmsym.name);
                asmsym.cachedObjSymbol:=result;
                FCachedAsmSymbolList.add(asmsym);
              end
            else
              result:=TObjSymbol(asmsym.cachedObjSymbol);
          end
        else
          result:=nil;
      end;


    function TObjData.symbolref(const aname:string):TObjSymbol;
      begin
        if not assigned(CurrObjSec) then
          internalerror(200603052);
        result:=CreateSymbol(aname);
      end;


    procedure TObjData.ResetCachedAsmSymbols;
      var
        i  : longint;
      begin
        for i:=0 to FCachedAsmSymbolList.Count-1 do
          tasmsymbol(FCachedAsmSymbolList[i]).cachedObjSymbol:=nil;
        FCachedAsmSymbolList.Clear;
      end;


    procedure TObjData.writebytes(const Data;len:aint);
      begin
        if not assigned(CurrObjSec) then
          internalerror(200402251);
        CurrObjSec.write(Data,len);
      end;


    procedure TObjData.alloc(len:aint);
      begin
        if not assigned(CurrObjSec) then
          internalerror(200402252);
        CurrObjSec.alloc(len);
      end;


    procedure TObjData.allocalign(len:shortint);
      begin
        if not assigned(CurrObjSec) then
          internalerror(200402253);
        CurrObjSec.alloc(align(CurrObjSec.size,len)-CurrObjSec.size);
      end;


    procedure TObjData.allocstab(p:pchar);
      begin
        if not(assigned(FStabsObjSec) and assigned(FStabStrObjSec)) then
          internalerror(200402254);
        FStabsObjSec.alloc(sizeof(TObjStabEntry));
        if assigned(p) and (p[0]<>#0) then
          FStabStrObjSec.alloc(strlen(p)+1);
      end;


    procedure TObjData.section_afteralloc(p:TObject;arg:pointer);
      begin
        with TObjSection(p) do
          alloc(align(size,secalign)-size);
      end;


    procedure TObjData.section_afterwrite(p:TObject;arg:pointer);
      begin
        with TObjSection(p) do
          begin
            if assigned(Data) then
              writezeros(align(size,secalign)-size);
          end;
      end;


    procedure TObjData.section_reset(p:TObject;arg:pointer);
      begin
        with TObjSection(p) do
          begin
            Size:=0;
            Datapos:=0;
            mempos:=0;
          end;
      end;


    procedure TObjData.beforealloc;
      begin
        { create stabs sections if debugging }
        if assigned(StabsSec) then
          begin
            StabsSec.Alloc(sizeof(TObjStabEntry));
            StabStrSec.Alloc(1);
          end;
      end;


    procedure TObjData.beforewrite;
      var
        s : string[1];
      begin
        { create stabs sections if debugging }
        if assigned(StabsSec) then
         begin
           writestab(0,nil,0,0,0,nil);
           s:=#0;
           stabstrsec.write(s[1],length(s));
         end;
      end;


    procedure TObjData.afteralloc;
      begin
        FObjSectionList.ForEachCall(@section_afteralloc,nil);
      end;


    procedure TObjData.afterwrite;
      var
        s : string[1];
        hstab : TObjStabEntry;
      begin
        FObjSectionList.ForEachCall(@section_afterwrite,nil);
        { For the stab section we need an HdrSym which can now be
          calculated more easily }
        if assigned(StabsSec) then
          begin
            { header stab }
            s:=#0;
            stabstrsec.write(s[1],length(s));
            hstab.strpos:=1;
            hstab.ntype:=0;
            hstab.nother:=0;
            hstab.ndesc:=(StabsSec.Size div sizeof(TObjStabEntry))-1;
            hstab.nvalue:=StabStrSec.Size;
            StabsSec.Data.seek(0);
            StabsSec.Data.write(hstab,sizeof(hstab));
          end;
      end;


    procedure TObjData.resetsections;
      begin
        FObjSectionList.ForEachCall(@section_reset,nil);
      end;


{****************************************************************************
                                TObjOutput
****************************************************************************}

    constructor TObjOutput.create(AWriter:TObjectWriter);
      begin
        FWriter:=AWriter;
        CObjData:=TObjData;
      end;


    destructor TObjOutput.destroy;
      begin
        inherited destroy;
      end;


    function TObjOutput.newObjData(const n:string):TObjData;
      begin
        result:=CObjData.create(n);
        if (cs_use_lineinfo in aktglobalswitches) or
           (cs_debuginfo in aktmoduleswitches) then
          result.CreateDebugSections;
      end;


    function TObjOutput.startObjectfile(const fn:string):boolean;
      begin
        result:=false;
        { start the writer already, so the .a generation can initialize
          the position of the current objectfile }
        if not FWriter.createfile(fn) then
         Comment(V_Fatal,'Can''t create object '+fn);
        result:=true;
      end;


    function TObjOutput.writeobjectfile(Data:TObjData):boolean;
      begin
        if errorcount=0 then
         result:=writeData(Data)
        else
         result:=true;
        { close the writer }
        FWriter.closefile;
      end;


    procedure TObjOutput.exportsymbol(p:TObjSymbol);
      begin
        { export globals and common symbols, this is needed
          for .a files }
        if p.bind in [AB_GLOBAL,AB_COMMON] then
         FWriter.writesym(p.name);
      end;


{****************************************************************************
                                 TExeVTable
****************************************************************************}

    constructor TExeVTable.Create(AExeSymbol:TExeSymbol);
      begin
        ExeSymbol:=AExeSymbol;
        if not assigned(ExeSymbol.ObjSymbol) then
          internalerror(200604012);
        ChildList:=TFPObjectList.Create(false);
      end;


    destructor TExeVTable.Destroy;
      begin
        ChildList.Free;
        if assigned(EntryArray) then
          Freemem(EntryArray);
      end;


    procedure TExeVTable.CheckIdx(VTableIdx:longint);
      var
        OldEntryCnt : longint;
      begin
        if VTableIdx>=EntryCnt then
          begin
            OldEntryCnt:=EntryCnt;
            EntryCnt:=VTableIdx+1;
            ReAllocMem(EntryArray,EntryCnt*sizeof(TVTableEntry));
            FillChar(EntryArray[OldEntryCnt],(EntryCnt-OldEntryCnt)*sizeof(TVTableEntry),0);
          end;
      end;


    procedure TExeVTable.AddChild(vt:TExeVTable);
      begin
        ChildList.Add(vt);
      end;


    procedure TExeVTable.AddEntry(VTableIdx:Longint);
      var
        i : longint;
        objreloc : TObjRelocation;
        vtblentryoffset : aint;
      begin
        CheckIdx(VTableIdx);
        vtblentryoffset:=ExeSymbol.ObjSymbol.Offset+VTableIdx*sizeof(aint);
        { Find and disable relocation }
        for i:=0 to ExeSymbol.ObjSymbol.ObjSection.ObjRelocations.Count-1 do
          begin
            objreloc:=TObjRelocation(ExeSymbol.ObjSymbol.ObjSection.ObjRelocations[i]);
            if objreloc.dataoffset=vtblentryoffset then
              begin
                EntryArray[VTableIdx].ObjRelocation:=objreloc;
                EntryArray[VTableIdx].OrgRelocType:=objreloc.typ;
                objreloc.typ:=RELOC_ZERO;
                break;
              end;
          end;
        if not assigned(EntryArray[VTableIdx].ObjRelocation) then
          internalerror(200604011);
      end;


    procedure TExeVTable.SetVTableSize(ASize:longint);
      begin
        if EntryCnt<>0 then
          internalerror(200603313);
        EntryCnt:=ASize div sizeof(aint);
        EntryArray:=AllocMem(EntryCnt*sizeof(TVTableEntry));
      end;


    function TExeVTable.VTableRef(VTableIdx:Longint):TObjRelocation;
      begin
        result:=nil;
        CheckIdx(VTableIdx);
        if EntryArray[VTableIdx].Used then
          exit;
        { Restore relocation if available }
        if assigned(EntryArray[VTableIdx].ObjRelocation) then
          begin
            EntryArray[VTableIdx].ObjRelocation.typ:=EntryArray[VTableIdx].OrgRelocType;
            result:=EntryArray[VTableIdx].ObjRelocation;
          end;
        EntryArray[VTableIdx].Used:=true;
      end;


{****************************************************************************
                                TExeSection
****************************************************************************}

    constructor TExeSection.create(AList:TFPHashObjectList;const AName:string);
      begin
        inherited create(AList,AName);
        Size:=0;
        MemPos:=0;
        DataPos:=0;
        FSecSymIdx:=0;
        FObjSectionList:=TFPObjectList.Create(false);
      end;


    destructor TExeSection.destroy;
      begin
        ObjSectionList.Free;
        inherited destroy;
      end;


    procedure TExeSection.AddObjSection(objsec:TObjSection);
      begin
        ObjSectionList.Add(objsec);
        if (SecOptions<>[]) then
          begin
            { Only if the section contains (un)initialized data the
              data flag must match. This check is not needed if the
              section is empty for a symbol allocation }
            if (objsec.size>0) and
               ((oso_Data in SecOptions)<>(oso_Data in objsec.SecOptions)) then
              Comment(V_Error,'Incompatible section options');
          end
        else
          begin
            { inherit section options }
            SecAlign:=objsec.SecAlign;
            SecOptions:=SecOptions+objsec.SecOptions;
          end;
        { relate ObjSection to ExeSection, and mark it Used by default }
        objsec.ExeSection:=self;
        objsec.Used:=true;
      end;


{****************************************************************************
                                TExternalLibrary
****************************************************************************}

    constructor TExternalLibrary.create(AList:TFPHashObjectList;const AName:string);
      begin
        inherited create(AList,AName);
        FExternalSymbolList:=TFPHashObjectList.Create(false);
      end;


    destructor TExternalLibrary.destroy;
      begin
        ExternalSymbolList.Free;
        inherited destroy;
      end;


{****************************************************************************
                                TExeOutput
****************************************************************************}

    constructor TExeOutput.create;
      begin
        { init writer }
        FWriter:=TObjectwriter.create;
        { object files }
        FObjDataList:=TFPObjectList.Create(true);
        { symbols }
        FExeSymbolList:=TFPHashObjectList.Create(true);
        FUnresolvedExeSymbols:=TFPObjectList.Create(false);
        FExternalObjSymbols:=TFPObjectList.Create(false);
        FCommonObjSymbols:=TFPObjectList.Create(false);
        FExeVTableList:=TFPObjectList.Create(false);
        FEntryName:='start';
        { sections }
        FExeSectionList:=TFPHashObjectList.Create(true);
        FImageBase:=0;
        SectionMemAlign:=$1000;
        SectionDataAlign:=$200;
        FCExeSection:=TExeSection;
        FCObjData:=TObjData;
      end;


    destructor TExeOutput.destroy;
      begin
        FExeSymbolList.free;
        UnresolvedExeSymbols.free;
        ExternalObjSymbols.free;
        CommonObjSymbols.free;
        ExeVTableList.free;
        FExeSectionList.free;
        ObjDatalist.free;
        FWriter.free;
        inherited destroy;
      end;


    function TExeOutput.writeexefile(const fn:string):boolean;
      begin
        result:=false;
        if FWriter.createfile(fn) then
         begin
           { Only write the .o if there are no errors }
           if errorcount=0 then
             result:=writeData
           else
             result:=true;
           { close the writer }
           FWriter.closefile;
         end
        else
         Comment(V_Fatal,'Can''t create executable '+fn);
      end;


    function  TExeOutput.FindExeSection(const aname:string):TExeSection;
      begin
        result:=TExeSection(FExeSectionList.Find(aname));
      end;


    procedure TExeOutput.AddObjData(ObjData:TObjData);
      begin
        if ObjData.classtype<>FCObjData then
          Comment(V_Error,'Invalid input object format for '+ObjData.name+' got '+ObjData.classname+' expected '+FCObjData.classname);
        ObjDataList.Add(ObjData);
      end;


    procedure TExeOutput.Load_Start;
      begin
        ObjDataList.Clear;
        { Globals defined in the linker script }
        if not assigned(internalObjData) then
          internalObjData:=CObjData.create('*Internal*');
        AddObjData(internalObjData);
        { Common Data section }
        commonObjSection:=internalObjData.createsection(sec_bss,'');
      end;


    procedure TExeOutput.Load_EntryName(const aname:string);
      begin
        EntryName:=aname;
      end;


    procedure TExeOutput.Load_IsSharedLibrary;
      begin
        IsSharedLibrary:=true;
      end;


    procedure TExeOutput.Load_ImageBase(const avalue:string);
      var
        code : integer;
      begin
        val(avalue,ImageBase,code);
      end;


    procedure TExeOutput.Load_Symbol(const aname:string);
      begin
        internalObjData.createsection('*'+aname,0,[]);
        internalObjData.SymbolDefine(aname,AB_GLOBAL,AT_FUNCTION);
      end;


    procedure TExeOutput.Order_Start;
      begin
      end;


    procedure TExeOutput.Order_End;
      begin
        internalObjData.afterwrite;
      end;


    procedure TExeOutput.Order_ExeSection(const aname:string);
      var
        sec : TExeSection;
      begin
        sec:=FindExeSection(aname);
        if not assigned(sec) then
          sec:=CExeSection.create(FExeSectionList,aname);
        { Clear ExeSection contents }
        FCurrExeSec:=sec;
      end;


    procedure TExeOutput.Order_EndExeSection;
      begin
        if not assigned(CurrExeSec) then
          internalerror(200602184);
        FCurrExeSec:=nil;
      end;


    procedure TExeOutput.Order_ObjSection(const aname:string);
      var
        i,j     : longint;
        ObjData : TObjData;
        objsec  : TObjSection;
      begin
        if not assigned(CurrExeSec) then
          internalerror(200602181);
        for i:=0 to ObjDataList.Count-1 do
          begin
            ObjData:=TObjData(ObjDataList[i]);
            for j:=0 to ObjData.ObjSectionList.Count-1 do
              begin
                objsec:=TObjSection(ObjData.ObjSectionList[j]);
                if MatchPattern(aname,objsec.name) then
                  CurrExeSec.AddObjSection(objsec);
              end;
          end;
      end;


    procedure TExeOutput.Order_Symbol(const aname:string);
      var
        ObjSection : TObjSection;
      begin
        ObjSection:=internalObjData.findsection('*'+aname);
        if not assigned(ObjSection) then
          internalerror(200603041);
        CurrExeSec.AddObjSection(ObjSection);
      end;


    procedure TExeOutput.Order_Align(const aname:string);
      var
        code     : integer;
        alignval : shortint;
        objsec   : TObjSection;
      begin
        val(aname,alignval,code);
        if alignval<=0 then
          exit;
        { Create an empty section with the required aligning }
        inc(Fzeronr);
        objsec:=internalObjData.createsection('*align'+tostr(Fzeronr),alignval,CurrExeSec.SecOptions+[oso_Data,oso_keep]);
        CurrExeSec.AddObjSection(objsec);
      end;


    procedure TExeOutput.Order_Zeros(const aname:string);
      var
        zeros : array[0..1023] of byte;
        code  : integer;
        len   : longint;
        objsec : TObjSection;
      begin
        val(aname,len,code);
        if len<=0 then
          exit;
        if len>sizeof(zeros) then
          internalerror(200602254);
        fillchar(zeros,len,0);
        inc(Fzeronr);
        objsec:=internalObjData.createsection('*zeros'+tostr(Fzeronr),0,CurrExeSec.SecOptions+[oso_Data,oso_keep]);
        internalObjData.writebytes(zeros,len);
        CurrExeSec.AddObjSection(objsec);
      end;


    procedure TExeOutput.CalcPos_ExeSection(const aname:string);
      var
        i      : longint;
        objsec : TObjSection;
      begin
        { Section can be removed }
        FCurrExeSec:=FindExeSection(aname);
        if not assigned(CurrExeSec) then
          exit;

        { Alignment of ExeSection }
        CurrMemPos:=align(CurrMemPos,SectionMemAlign);
        CurrExeSec.MemPos:=CurrMemPos;
        if (oso_Data in currexesec.SecOptions) then
          begin
            CurrDataPos:=align(CurrDataPos,SectionDataAlign);
            CurrExeSec.DataPos:=CurrDataPos;
          end;

        { set position of object ObjSections }
        for i:=0 to CurrExeSec.ObjSectionList.Count-1 do
          begin
            objsec:=TObjSection(CurrExeSec.ObjSectionList[i]);
            { Position in memory }
            objsec.setmempos(CurrMemPos);
            { Position in File }
            if (oso_Data in objsec.SecOptions) then
              begin
                if not (oso_Data in currexesec.SecOptions) then
                  internalerror(200603043);
                if not assigned(objsec.Data) then
                  internalerror(200603044);
                objsec.setDatapos(CurrDataPos);
              end;
          end;

        { calculate size of the section }
        CurrExeSec.Size:=CurrMemPos-CurrExeSec.MemPos;
      end;


    procedure TExeOutput.CalcPos_EndExeSection;
      begin
        if not assigned(CurrExeSec) then
          exit;
        FCurrExeSec:=nil;
      end;


    procedure TExeOutput.CalcPos_Start;
      begin
        CurrMemPos:=0;
        CurrDataPos:=0;
      end;


    procedure TExeOutput.CalcPos_Header;
      begin
      end;


    procedure TExeOutput.CalcPos_Symbols;
      begin
      end;


    procedure TExeOutput.BuildVTableTree(VTInheritList,VTEntryList:TFPObjectList);
      var
        hs : string;
        code : integer;
        i,k,
        vtableidx : longint;
        vtableexesym,
        childexesym,
        parentexesym : TExeSymbol;
        objsym : TObjSymbol;
      begin
        { Build inheritance tree from VTINHERIT }
        for i:=0 to VTInheritList.Count-1 do
          begin
            objsym:=TObjSymbol(VTInheritList[i]);
            hs:=objsym.name;
            { VTINHERIT_<ChildVMTName>$$<ParentVMTName> }
            Delete(hs,1,Pos('_',hs));
            k:=Pos('$$',hs);
            if k=0 then
              internalerror(200603311);
            childexesym:=texesymbol(FExeSymbolList.Find(Copy(hs,1,k-1)));
            parentexesym:=texesymbol(FExeSymbolList.Find(Copy(hs,k+2,length(hs)-k-1)));
            if not assigned(childexesym) or
               not assigned(parentexesym)then
              internalerror(200603312);
            if not assigned(childexesym.vtable) then
              begin
                childexesym.vtable:=TExeVTable.Create(childexesym);
                ExeVTableList.Add(childexesym.vtable);
              end;
            if not assigned(parentexesym.vtable) then
              begin
                parentexesym.vtable:=TExeVTable.Create(parentexesym);
                ExeVTableList.Add(parentexesym.vtable);
              end;
            childexesym.vtable.SetVTableSize(childexesym.ObjSymbol.Size);
            if parentexesym<>childexesym then
              parentexesym.vtable.AddChild(childexesym.vtable);
          end;

        { Find VTable entries from VTENTRY }
        for i:=0 to VTEntryList.Count-1 do
          begin
            objsym:=TObjSymbol(VTEntryList[i]);
            hs:=objsym.name;
            { VTENTRY_<VTableName>$$<Index> }
            Delete(hs,1,Pos('_',hs));
            k:=Pos('$$',hs);
            if k=0 then
              internalerror(200603319);
            vtableexesym:=texesymbol(FExeSymbolList.Find(Copy(hs,1,k-1)));
            val(Copy(hs,k+2,length(hs)-k-1),vtableidx,code);
            if (code<>0) then
              internalerror(200603318);
            if not assigned(vtableexesym) then
              internalerror(2006033110);
            vtableexesym.vtable.AddEntry(vtableidx);
          end;
      end;


    procedure TExeOutput.ResolveSymbols;
      var
        ObjData   : TObjData;
        exesym    : TExeSymbol;
        objsym,
        commonsym : TObjSymbol;
        firstcommon : boolean;
        i,j       : longint;
        hs        : string;
        VTEntryList,
        VTInheritList : TFPObjectList;
      begin
        VTEntryList:=TFPObjectList.Create(false);
        VTInheritList:=TFPObjectList.Create(false);

        {
          The symbol calculation is done in 3 steps:
           1. register globals
              register externals
              register commons
           2. try to find commons, if not found then
              add to the globals (so externals can be resolved)
           3. try to find externals
        }

        { Step 1, Register symbols }
        for i:=0 to ObjDataList.Count-1 do
          begin
            ObjData:=TObjData(ObjDataList[i]);
            for j:=0 to ObjData.ObjSymbolList.Count-1 do
              begin
                objsym:=TObjSymbol(ObjData.ObjSymbolList[j]);
                { From the local symbols we are only interressed in the
                  VTENTRY and VTINHERIT symbols }
                if objsym.bind=AB_LOCAL then
                  begin
                    if cs_link_opt_vtable in aktglobalswitches then
                      begin
                        hs:=objsym.name;
                        if (hs[1]='V') then
                          begin
                            if Copy(hs,1,5)='VTREF' then
                              begin
                                if not assigned(objsym.ObjSection.VTRefList) then
                                  objsym.ObjSection.VTRefList:=TFPObjectList.Create(false);
                                objsym.ObjSection.VTRefList.Add(objsym);
                              end
                            else if Copy(hs,1,7)='VTENTRY' then
                              VTEntryList.Add(objsym)
                            else if Copy(hs,1,9)='VTINHERIT' then
                              VTInheritList.Add(objsym);
                          end;
                      end;
                    continue;
                  end;
                { Search for existing exesymbol }
                exesym:=texesymbol(FExeSymbolList.Find(objsym.name));
                if not assigned(exesym) then
                  exesym:=texesymbol.Create(FExeSymbolList,objsym.name);
                { Defining the symbol? }
                if objsym.bind=AB_GLOBAL then
                  begin
                    if not assigned(exesym.ObjSymbol) then
                      exesym.ObjSymbol:=objsym
                    else
                      Comment(V_Error,'Multiple defined symbol '+objsym.name);
                  end;
                objsym.exesymbol:=exesym;
                case objsym.bind of
                  AB_EXTERNAL :
                    ExternalObjSymbols.add(objsym);
                  AB_COMMON :
                    CommonObjSymbols.add(objsym);
                end;
              end;
          end;

        { Step 2, Match common symbols or add to the globals }
        firstcommon:=true;
        for i:=0 to CommonObjSymbols.count-1 do
          begin
            objsym:=TObjSymbol(CommonObjSymbols[i]);
            if assigned(objsym.exesymbol.objsymbol) then
              begin
                if objsym.exesymbol.ObjSymbol.size<>objsym.size then
                  internalerror(200206301);
              end
            else
              begin
                { allocate new objsymbol in .bss of *COMMON* and assign
                  it to the exesymbol }
                if firstcommon then
                  begin
                    if assigned(exemap) then
                      exemap.AddCommonSymbolsHeader;
                    firstcommon:=false;
                  end;
                internalObjData.setsection(commonObjSection);
                commonsym:=internalObjData.symboldefine(objsym.name,AB_GLOBAL,AT_FUNCTION);
                commonsym.size:=objsym.size;
                internalObjData.alloc(objsym.size);
                if assigned(exemap) then
                  exemap.AddCommonSymbol(commonsym);
                { Assign to the exesymbol }
                objsym.exesymbol.objsymbol:=commonsym
              end;
          end;

        { Generate a list of Unresolved External symbols }
        for i:=0 to ExeSymbolList.count-1 do
          begin
            exesym:=TExeSymbol(ExeSymbolList[i]);
            if exesym.objsymbol=nil then
              UnresolvedExeSymbols.Add(exesym);
          end;
        Comment(V_Debug,'Number of unresolved externals in objects '+tostr(UnresolvedExeSymbols.Count));

        { Find entry symbol and print in map }
        exesym:=texesymbol(ExeSymbolList.Find(EntryName));
        if assigned(exesym) then
          begin
            EntrySym:=exesym.ObjSymbol;
            if assigned(exemap) then
              begin
                exemap.Add('');
                exemap.Add('Entry symbol '+EntryName);
              end;
          end
        else
          Comment(V_Error,'Entrypoint '+EntryName+' not defined');

        { Generate VTable tree }
        if cs_link_opt_vtable in aktglobalswitches then
          BuildVTableTree(VTInheritList,VTEntryList);
        VTInheritList.Free;
        VTEntryList.Free;
      end;


    procedure TExeOutput.GenerateLibraryImports(ExternalLibraryList:TFPHashObjectList);
      begin
      end;


    procedure TExeOutput.PrintMemoryMap;
      var
        exesec : TExeSection;
        objsec : TObjSection;
        objsym : TObjSymbol;
        i,j,k  : longint;
      begin
        if not assigned(exemap) then
          exit;
        exemap.AddMemoryMapHeader(ImageBase);
        for i:=0 to ExeSections.Count-1 do
          begin
            exesec:=TExeSection(ExeSections[i]);
            exemap.AddMemoryMapExeSection(exesec);
            for j:=0 to exesec.ObjSectionList.count-1 do
              begin
                objsec:=TObjSection(exesec.ObjSectionList[j]);
                exemap.AddMemoryMapObjectSection(objsec);
                for k:=0 to objsec.ObjSymbolDefines.Count-1 do
                  begin
                    objsym:=TObjSymbol(objsec.ObjSymbolDefines[k]);
                    exemap.AddMemoryMapSymbol(objsym);
                  end;
              end;
          end;
      end;


    procedure TExeOutput.FixupSymbols;
      var
        i   : longint;
        sym : TObjSymbol;
      begin
        { Update ImageBase to ObjData so it can access from ObjSymbols }
        for i:=0 to ObjDataList.Count-1 do
          TObjData(ObjDataList[i]).imagebase:=imagebase;

        {
          Fixing up symbols is done in the following steps:
           1. Update common references
           2. Update external references
        }

        { Step 1, Update commons }
        for i:=0 to CommonObjSymbols.count-1 do
          begin
            sym:=TObjSymbol(CommonObjSymbols[i]);
            if sym.bind=AB_COMMON then
              begin
                { update this symbol }
                sym.bind:=sym.exesymbol.ObjSymbol.bind;
                sym.offset:=sym.exesymbol.ObjSymbol.offset;
                sym.size:=sym.exesymbol.ObjSymbol.size;
                sym.typ:=sym.exesymbol.ObjSymbol.typ;
                sym.ObjSection:=sym.exesymbol.ObjSymbol.ObjSection;
              end;
          end;

        { Step 2, Update externals }
        for i:=0 to ExternalObjSymbols.count-1 do
          begin
            sym:=TObjSymbol(ExternalObjSymbols[i]);
            if sym.bind=AB_EXTERNAL then
              begin
                if assigned(sym.exesymbol.ObjSymbol) then
                  begin
                    { update this symbol }
                    sym.bind:=sym.exesymbol.ObjSymbol.bind;
                    sym.offset:=sym.exesymbol.ObjSymbol.offset;
                    sym.size:=sym.exesymbol.ObjSymbol.size;
                    sym.typ:=sym.exesymbol.ObjSymbol.typ;
                    sym.ObjSection:=sym.exesymbol.ObjSymbol.ObjSection;
                  end
                else
                  Comment(V_Error,'Undefined symbol: '+sym.name);
              end;
          end;
      end;


    procedure TExeOutput.MergeStabs;
      var
        stabexesec,
        stabstrexesec : TExeSection;
        relocsec,
        currstabsec,
        currstabstrsec,
        mergedstabsec,
        mergedstabstrsec : TObjSection;
        hstabreloc,
        currstabreloc : TObjRelocation;
        currstabrelocidx,
        i,j,
        mergestabcnt,
        stabcnt : longint;
        skipstab : boolean;
        hstab   : TObjStabEntry;
        stabrelocofs : longint;
        buf     : array[0..1023] of byte;
        bufend,
        bufsize  : longint;
      begin
        stabexesec:=FindExeSection('.stab');
        stabstrexesec:=FindExeSection('.stabstr');
        if (stabexesec=nil) or
           (stabstrexesec=nil) or
           (stabexesec.ObjSectionlist.count=0) then
          exit;
        { Create new stabsection }
        stabRelocofs:[email protected]@hstab;
        mergedstabsec:=internalObjData.CreateSection(sec_stab,'');
        mergedstabstrsec:=internalObjData.CreateSection(sec_stabstr,'');

        { write stab for hdrsym }
        fillchar(hstab,sizeof(TObjStabEntry),0);
        mergedstabsec.write(hstab,sizeof(TObjStabEntry));
        mergestabcnt:=1;

        { .stabstr starts with a #0 }
        buf[0]:=0;
        mergedstabstrsec.write(buf[0],1);

        { Copy stabs and corresponding Relocations }
        for i:=0 to stabexesec.ObjSectionList.Count-1 do
          begin
            currstabsec:=TObjSection(stabexesec.ObjSectionList[i]);
            currstabstrsec:=currstabsec.ObjData.findsection('.stabstr');
            if assigned(currstabstrsec) then
              begin
                stabcnt:=currstabsec.Data.size div sizeof(TObjStabEntry);
                currstabsec.Data.seek(0);
                currstabrelocidx:=0;
                for j:=0 to stabcnt-1 do
                  begin
                    hstabreloc:=nil;
                    skipstab:=false;
                    currstabsec.Data.read(hstab,sizeof(TObjStabEntry));
                    { Only include first hdrsym stab }
                    if hstab.ntype=0 then
                      skipstab:=true;
                    if not skipstab then
                      begin
                        { Find corresponding Relocation }
                        currstabreloc:=nil;
                        while (currstabrelocidx<currstabsec.ObjRelocations.Count) do
                          begin
                            currstabreloc:=TObjRelocation(currstabsec.ObjRelocations[currstabrelocidx]);
                            if assigned(currstabreloc) and
                               (currstabreloc.dataoffset>=j*sizeof(TObjStabEntry)+stabrelocofs) then
                              break;
                            inc(currstabrelocidx);
                          end;
                        if assigned(currstabreloc) and
                           (currstabreloc.dataoffset=j*sizeof(TObjStabEntry)+stabrelocofs) then
                          begin
                            hstabReloc:=currstabReloc;
                            inc(currstabrelocidx);
                          end;

                        { Check if the stab is refering to a removed section }
                        if assigned(hstabreloc) then
                          begin
                            if assigned(hstabreloc.Symbol) then
                              relocsec:=hstabreloc.Symbol.ObjSection
                            else
                              relocsec:=hstabreloc.ObjSection;
                            if not assigned(relocsec) then
                              internalerror(200603302);
                            if not relocsec.Used then
                              skipstab:=true;
                          end;
                      end;
                    if not skipstab then
                      begin
                        { Copy string in stabstr }
                        if hstab.strpos<>0 then
                          begin
                            currstabstrsec.Data.seek(hstab.strpos);
                            hstab.strpos:=mergedstabstrsec.Size;
                            repeat
                              bufsize:=currstabstrsec.Data.read(buf,sizeof(buf));
                              bufend:=indexbyte(buf,bufsize,0);
                              if bufend=-1 then
                                bufend:=bufsize
                              else
                                begin
                                  { include the #0 }
                                  inc(bufend);
                                end;
                              mergedstabstrsec.write(buf,bufend);
                            until (buf[bufend-1]=0) or (bufsize<sizeof(buf));
                          end;
                        { Copy and Update the relocation }
                        if assigned(hstabreloc) then
                          begin
                            hstabreloc.Dataoffset:=mergestabcnt*sizeof(TObjStabEntry)+stabRelocofs;
                            { Remove from List without freeing the object }
                            currstabsec.ObjRelocations.List[currstabrelocidx-1]:=nil;
                            mergedstabsec.ObjRelocations.Add(hstabreloc);
                          end;
                        { Write updated stab }
                        mergedstabsec.write(hstab,sizeof(hstab));
                        inc(mergestabcnt);
                      end;
                  end;
              end;

            { Unload stabs }
            if assigned(currstabstrsec) then
              begin
                currstabstrsec.Used:=False;
                currstabstrsec.ReleaseData;
              end;
            currstabsec.Used:=false;
            currstabsec.ReleaseData;
          end;

        { Generate new HdrSym }
        if mergedstabsec.Size>0 then
          begin
            hstab.strpos:=1;
            hstab.ntype:=0;
            hstab.nother:=0;
            hstab.ndesc:=word(mergestabcnt-1);
            hstab.nvalue:=mergedstabstrsec.Size;
            mergedstabsec.Data.seek(0);
            mergedstabsec.Data.write(hstab,sizeof(hstab));
          end;

        { Replace all sections with our combined stabsec }
        stabexesec.ObjSectionList.Clear;
        stabstrexesec.ObjSectionList.Clear;
        stabexesec.AddObjSection(mergedstabsec);
        stabstrexesec.AddObjSection(mergedstabstrsec);
      end;


    procedure TExeOutput.RemoveEmptySections;
      var
        i      : longint;
        exesec : TExeSection;
      begin
        for i:=0 to ExeSections.Count-1 do
          begin
            exesec:=TExeSection(ExeSections[i]);
            if not(oso_keep in exesec.SecOptions) and
               (
                (exesec.ObjSectionlist.count=0) or
                (
                 (cs_link_strip in aktglobalswitches) and
                 (oso_debug in exesec.SecOptions)
                )
               ) then
              begin
                Comment(V_Debug,'Deleting empty section '+exesec.name);
                FExeSectionList.Delete(i);
              end;
          end;
        ExeSections.Pack;
      end;


    procedure TExeOutput.RemoveUnreferencedSections;
      var
        ObjSectionWorkList : TFPObjectList;

        procedure AddToObjSectionWorkList(aobjsec:TObjSection);
        begin
          if not aobjsec.Used then
            begin
              aobjsec.Used:=true;
              ObjSectionWorkList.Add(aobjsec);
            end;
        end;

        procedure DoReloc(objreloc:TObjRelocation);
        var
          objsym : TObjSymbol;
          refobjsec : TObjSection;
        begin
          { Disabled Relocation to 0  }
          if objreloc.typ=RELOC_ZERO then
            exit;
          if assigned(objreloc.symbol) then
            begin
              objsym:=objreloc.symbol;
              if objsym.bind<>AB_LOCAL then
                begin
                  if not(assigned(objsym.exesymbol) and
                        assigned(objsym.exesymbol.objsymbol)) then
                    internalerror(200603063);
                  objsym:=objsym.exesymbol.objsymbol;
                end;
              if not assigned(objsym.objsection) then
                internalerror(200603062);
              refobjsec:=objsym.objsection;
            end
          else
            if assigned(objreloc.objsection) then
              refobjsec:=objreloc.objsection
          else
            internalerror(200603316);
          if assigned(exemap) then
            exemap.Add('  References '+refobjsec.fullname);
          AddToObjSectionWorkList(refobjsec);
        end;

        procedure DoVTableRef(vtable:TExeVTable;VTableIdx:longint);
        var
          i : longint;
          objreloc : TObjRelocation;
        begin
          objreloc:=vtable.VTableRef(VTableIdx);
          if assigned(objreloc) then
            begin
              { Process the relocation now if the ObjSection is
                already processed and marked as used. Otherwise we leave it
                unprocessed. It'll then be resolved when the ObjSection is
                changed to Used }
              if vtable.ExeSymbol.ObjSymbol.ObjSection.Used then
                DoReloc(objreloc);
            end;
          { This recursive walking is done here instead of
            in TExeVTable.VTableRef because we can now process
            all needed relocations }
          for i:=0 to vtable.ChildList.Count-1 do
            DoVTableRef(TExeVTable(vtable.ChildList[i]),VTableIdx);
        end;

      var
        hs        : string;
        i,j,k     : longint;
        exesec    : TExeSection;
        objdata   : TObjData;
        objsec    : TObjSection;
        objsym    : TObjSymbol;
        code      : integer;
        vtableidx : longint;
        vtableexesym : TExeSymbol;
      begin
        ObjSectionWorkList:=TFPObjectList.Create(false);

        if assigned(exemap) then
          exemap.AddHeader('Removing unreferenced sections');

        { Initialize by marking all sections unused and
          adding the sections with oso_keep flags to the ObjSectionWorkList }
        for i:=0 to ObjDataList.Count-1 do
          begin
            ObjData:=TObjData(ObjDataList[i]);
            for j:=0 to ObjData.ObjSectionList.Count-1 do
              begin
                objsec:=TObjSection(ObjData.ObjSectionList[j]);
                objsec.Used:=false;
{$warning TODO remove debug section always keep}
                if oso_debug in objsec.secoptions then
                  objsec.Used:=true;
                if (oso_keep in objsec.secoptions) then
                  AddToObjSectionWorkList(objsec);
              end;
          end;
        AddToObjSectionWorkList(entrysym.exesymbol.objsymbol.objsection);

        { Process all sections, add new sections to process based
          on the symbol references  }
        while ObjSectionWorkList.Count>0 do
          begin
            objsec:=TObjSection(ObjSectionWorkList.Last);
            if assigned(exemap) then
              exemap.Add('Keeping '+objsec.FullName+' '+ToStr(objsec.ObjRelocations.Count)+' references');
            ObjSectionWorkList.Delete(ObjSectionWorkList.Count-1);

            { Process Relocations }
            for i:=0 to objsec.ObjRelocations.count-1 do
              DoReloc(TObjRelocation(objsec.ObjRelocations[i]));

            { Process Virtual Entry calls }
            if cs_link_opt_vtable in aktglobalswitches then
              begin
                for i:=0 to objsec.VTRefList.count-1 do
                  begin
                    objsym:=TObjSymbol(objsec.VTRefList[i]);
                    hs:=objsym.name;
                    Delete(hs,1,Pos('_',hs));
                    k:=Pos('$$',hs);
                    if k=0 then
                      internalerror(200603314);
                    vtableexesym:=texesymbol(FExeSymbolList.Find(Copy(hs,1,k-1)));
                    val(Copy(hs,k+2,length(hs)-k-1),vtableidx,code);
                    if (code<>0) then
                      internalerror(200603317);
                    if not assigned(vtableexesym) then
                      internalerror(200603315);
                    if not assigned(vtableexesym.vtable) then
                      internalerror(200603316);
                    DoVTableRef(vtableexesym.vtable,vtableidx);
                  end;
              end;
          end;
        ObjSectionWorkList.Free;
        ObjSectionWorkList:=nil;

        { Remove unused objsections from exesections }
        for i:=0 to ExeSections.Count-1 do
          begin
            exesec:=TExeSection(ExeSections[i]);
            for j:=0 to exesec.ObjSectionlist.count-1 do
              begin
                objsec:=TObjSection(exesec.ObjSectionlist[j]);
                if not objsec.used then
                  begin
                    if assigned(exemap) then
                      exemap.Add('Removing '+objsec.FullName);
                    exesec.ObjSectionlist[j]:=nil;
                    objsec.ReleaseData;
                  end;
              end;
            exesec.ObjSectionlist.Pack;
          end;
      end;


    procedure TExeOutput.FixupRelocations;
      var
        i,j     : longint;
        exesec  : TExeSection;
        objsec  : TObjSection;
      begin
        for i:=0 to ExeSections.Count-1 do
          begin
            exesec:=TExeSection(ExeSections[i]);
            if not assigned(exesec) then
              continue;
            for j:=0 to exesec.ObjSectionlist.count-1 do
              begin
                objsec:=TObjSection(exesec.ObjSectionlist[j]);
                if not objsec.Used then
                  internalerror(200603301);
                objsec.FixupRelocs;
              end;
          end;
      end;


{****************************************************************************
                                TObjInput
****************************************************************************}

    constructor TObjInput.create;
      begin
        { init reader }
        FReader:=TObjectreader.create;
      end;


    destructor TObjInput.destroy;
      begin
        FReader.free;
        inherited destroy;
      end;


    function TObjInput.newObjData(const n:string):TObjData;
      begin
        result:=CObjData.create(n);
      end;


    function TObjInput.readobjectfile(const fn:string;Data:TObjData):boolean;
      begin
        result:=false;
        { start the reader }
        if FReader.openfile(fn) then
         begin
           result:=readObjData(Data);
           FReader.closefile;
         end;
      end;

    procedure TObjInput.inputerror(const s : string);
      begin
        Comment(V_Error,s+' while reading '+reader.filename);
      end;


{$ifdef MEMDEBUG}
initialization
  memobjsymbols:=TMemDebug.create('ObjSymbols');
  memobjsymbols.stop;
  memobjsections:=TMemDebug.create('ObjSections');
  memobjsections.stop;

finalization
  memobjsymbols.free;
  memobjsections.free;
{$endif MEMDEBUG}
end.