freepascal.compiler/compiler/ogelf.pas

{
    Copyright (c) 1998-2006 by Peter Vreman

    Contains the binary elf writer

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

{$i fpcdefs.inc}

interface

    uses
       { common }
       cclasses,globtype,
       { target }
       systems,
       { assembler }
       cpuinfo,cpubase,aasmbase,aasmtai,aasmdata,assemble,
       { output }
       ogbase,
       owbase;

    type
       TElfObjSection = class(TObjSection)
       public
          secshidx  : longint; { index for the section in symtab }
          shstridx,
          shtype,
          shflags,
          shlink,
          shinfo,
          shentsize : longint;
          constructor create(AList:TFPHashObjectList;const Aname:string;Aalign:shortint;Aoptions:TObjSectionOptions);override;
          constructor create_ext(aobjdata:TObjData;const Aname:string;Ashtype,Ashflags,Ashlink,Ashinfo:longint;Aalign:shortint;Aentsize:longint);
       end;

       TElfSymtabKind = (esk_obj,esk_exe,esk_dyn);

       TElfSymtab = class(TElfObjSection)
       public
         kind: TElfSymtabKind;
         fstrsec: TObjSection;
         symidx: longint;
         constructor create(aObjData:TObjData;aKind:TElfSymtabKind);reintroduce;
         procedure writeSymbol(objsym:TObjSymbol);
         procedure writeInternalSymbol(astridx:longint;ainfo:byte;ashndx:word);
       end;

       TElfObjData = class(TObjData)
       public
         constructor create(const n:string);override;
         function  sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;override;
         procedure CreateDebugSections;override;
         procedure writereloc(data:aint;len:aword;p:TObjSymbol;reltype:TObjRelocationType);override;
       end;

       TElfObjectOutput = class(tObjOutput)
       private
         symtabsect: TElfSymtab;
         shstrtabsect: TElfObjSection;
         procedure createrelocsection(s:TElfObjSection;data:TObjData);
         procedure createshstrtab(data:TObjData);
         procedure createsymtab(data: TObjData);
         procedure writesectionheader(s:TElfObjSection);
         procedure section_write_symbol(p:TObject;arg:pointer);
         procedure section_write_sh_string(p:TObject;arg:pointer);
         procedure section_count_sections(p:TObject;arg:pointer);
         procedure section_create_relocsec(p:TObject;arg:pointer);
         procedure section_write_sechdr(p:TObject;arg:pointer);
       protected
         function writedata(data:TObjData):boolean;override;
       public
         constructor Create(AWriter:TObjectWriter);override;
       end;

       TElfAssembler = class(tinternalassembler)
         constructor create(smart:boolean);override;
       end;


implementation

      uses
        SysUtils,
        verbose,
        cutils,globals,fmodule;

    const
      symbolresize = 200*18;

    const
      { Relocation types }
{$ifdef i386}
      R_386_32 = 1;                    { ordinary absolute relocation }
      R_386_PC32 = 2;                  { PC-relative relocation }
      R_386_GOT32 = 3;                 { an offset into GOT }
      R_386_PLT32 = 4;                 { a PC-relative offset into PLT }
      R_386_GOTOFF = 9;                { an offset from GOT base }
      R_386_GOTPC = 10;                { a PC-relative offset _to_ GOT }
      R_386_GNU_VTINHERIT = 250;
      R_386_GNU_VTENTRY = 251;
{$endif i386}
{$ifdef sparc}
      R_SPARC_32 = 3;
      R_SPARC_WDISP30 = 7;
      R_SPARC_HI22 = 9;
      R_SPARC_LO10 = 12;
      R_SPARC_GNU_VTINHERIT = 250;
      R_SPARC_GNU_VTENTRY = 251;
{$endif sparc}
{$ifdef x86_64}
      R_X86_64_NONE = 0;
      R_X86_64_64 = 1;                 { Direct 64 bit   }
      R_X86_64_PC32 = 2;               { PC relative 32 bit signed  }
      R_X86_64_GOT32 = 3;              { 32 bit GOT entry  }
      R_X86_64_PLT32 = 4;              { 32 bit PLT address  }
      R_X86_64_COPY = 5;               { Copy symbol at runtime  }
      R_X86_64_GLOB_DAT = 6;           { Create GOT entry  }
      R_X86_64_JUMP_SLOT = 7;          { Create PLT entry  }
      R_X86_64_RELATIVE = 8;           { Adjust by program base  }
      R_X86_64_GOTPCREL = 9;           { 32 bit signed PC relative offset to GOT  }
      R_X86_64_32 = 10;                { Direct 32 bit zero extended  }
      R_X86_64_32S = 11;               { Direct 32 bit sign extended  }
      R_X86_64_16 = 12;                { Direct 16 bit zero extended  }
      R_X86_64_PC16 = 13;              { 16 bit sign extended PC relative  }
      R_X86_64_8 = 14;                 { Direct 8 bit sign extended   }
      R_X86_64_PC8 = 15;               { 8 bit sign extended PC relative  }
      R_X86_64_DTPMOD64 = 16;          { ID of module containing symbol  }
      R_X86_64_DTPOFF64 = 17;          { Offset in module's TLS block  }
      R_X86_64_TPOFF64 = 18;           { Offset in initial TLS block  }
      { 32 bit signed PC relative offset to two GOT entries for GD symbol  }
      R_X86_64_TLSGD = 19;
      { 32 bit signed PC relative offset to two GOT entries for LD symbol  }
      R_X86_64_TLSLD = 20;
      R_X86_64_DTPOFF32 = 21;          { Offset in TLS block  }
      { 32 bit signed PC relative offset to GOT entry for IE symbol  }
      R_X86_64_GOTTPOFF = 22;
      R_X86_64_TPOFF32 = 23;           { Offset in initial TLS block  }
      R_X86_64_PC64 = 24;              { PC relative 64-bit signed }
      R_X86_64_GOTOFF64 = 25;          { 64-bit offset from GOT base }
      R_X86_64_GOTPC32 = 26;           { PC-relative offset GOT }
      R_X86_64_GOT64  = 27;            { 64-bit GOT entry offset }
      R_X86_64_GOTPCREL64 = 28;        { 64-bit PC relative offset to GOT entry }
      R_X86_64_GOTPC64 = 29;           { 64-bit PC relative offset to GOT }
      R_X86_64_GOTPLT64 = 30;          { Like GOT64, indicates that PLT entry needed }
      R_X86_64_PLTOFF64 = 31;          { 64-bit GOT relative offset to PLT entry }
      R_X86_64_SIZE32 = 32;
      R_X86_64_SIZE64 = 33;
      R_X86_64_GOTPC32_TLSDESC = 34;
      R_X86_64_TLSDESC_CALL = 35;
      R_X86_64_TLSDESC = 36;
      R_X86_64_IRELATIVE = 37;
      R_X86_64_GNU_VTINHERIT = 250;    { GNU extension to record C++ vtable hierarchy }
      R_X86_64_GNU_VTENTRY = 251;      { GNU extension to record C++ vtable member usage }
{$endif x86_64}

      { ELFHeader.file_class }
      ELFCLASSNONE  = 0;
      ELFCLASS32    = 1;
      ELFCLASS64    = 2;

      { ELFHeader.e_type }
      ET_NONE       = 0;
      ET_REL        = 1;
      ET_EXEC       = 2;
      ET_DYN        = 3;
      ET_CORE       = 4;

      { ELFHeader.e_machine }
      EM_SPARC      = 2;
      EM_386        = 3;
      EM_M68K       = 4;
      EM_PPC        = 20;
      EM_ARM        = 40;
      EM_X86_64     = 62;

{$ifdef sparc}
      ELFMACHINE = EM_SPARC;
{$endif sparc}
{$ifdef i386}
      ELFMACHINE = EM_386;
{$endif i386}
{$ifdef m68k}
      ELFMACHINE = EM_M68K;
{$endif m68k}
{$ifdef powerpc}
      ELFMACHINE = EM_PPC;
{$endif powerpc}
{$ifdef arm}
      ELFMACHINE = EM_ARM;
{$endif arm}
{$ifdef x86_64}
      ELFMACHINE = EM_X86_64;
{$endif x86_64}

      SHN_UNDEF     = 0;
      SHN_ABS       = $fff1;
      SHN_COMMON    = $fff2;

      SHT_NULL     = 0;
      SHT_PROGBITS = 1;
      SHT_SYMTAB   = 2;
      SHT_STRTAB   = 3;
      SHT_RELA     = 4;
      SHT_HASH     = 5;
      SHT_DYNAMIC  = 6;
      SHT_NOTE     = 7;
      SHT_NOBITS   = 8;
      SHT_REL      = 9;
      SHT_SHLIB    = 10;
      SHT_DYNSYM   = 11;

      SHF_WRITE     = 1;
      SHF_ALLOC     = 2;
      SHF_EXECINSTR = 4;

      STB_LOCAL   = 0;
      STB_GLOBAL  = 1;
      STB_WEAK    = 2;

      STT_NOTYPE  = 0;
      STT_OBJECT  = 1;
      STT_FUNC    = 2;
      STT_SECTION = 3;
      STT_FILE    = 4;

      { program header types }
      PT_NULL     = 0;
      PT_LOAD     = 1;
      PT_DYNAMIC  = 2;
      PT_INTERP   = 3;
      PT_NOTE     = 4;
      PT_SHLIB    = 5;
      PT_PHDR     = 6;
      PT_LOPROC   = $70000000;
      PT_HIPROC   = $7FFFFFFF;

      { program header flags }
      PF_X = 1;
      PF_W = 2;
      PF_R = 4;
      PF_MASKPROC = $F0000000;

      { .dynamic tags  }
      DT_NULL     = 0;
      DT_NEEDED   = 1;
      DT_PLTRELSZ = 2;
      DT_PLTGOT   = 3;
      DT_HASH     = 4;
      DT_STRTAB   = 5;
      DT_SYMTAB	  = 6;
      DT_RELA     = 7;
      DT_RELASZ   = 8;
      DT_RELAENT  = 9;
      DT_STRSZ    = 10;
      DT_SYMENT   = 11;
      DT_INIT     = 12;
      DT_FINI     = 13;
      DT_SONAME   = 14;
      DT_RPATH    = 15;
      DT_SYMBOLIC = 16;
      DT_REL      = 17;
      DT_RELSZ    = 18;
      DT_RELENT   = 19;
      DT_PLTREL   = 20;
      DT_DEBUG    = 21;
      DT_TEXTREL  = 22;
      DT_JMPREL   = 23;
      DT_BIND_NOW = 24;
      DT_INIT_ARRAY = 25;
      DT_FINI_ARRAY = 26;
      DT_INIT_ARRAYSZ = 27;
      DT_FINI_ARRAYSZ = 28;
      DT_RUNPATH  = 29;
      DT_FLAGS    = 30;
      DT_ENCODING = 32;
      DT_PREINIT_ARRAY   = 32;
      DT_PREINIT_ARRAYSZ = 33;
      DT_NUM      = 34;
      DT_LOOS     = $6000000D;
      DT_HIOS     = $6ffff000;
      DT_LOPROC   = $70000000;
      DT_HIPROC   = $7fffffff;

      type
      { Structures which are written directly to the output file }
        TElf32header=packed record
          magic             : array[0..3] of byte;
          file_class        : byte;
          data_encoding     : byte;
          file_version      : byte;
          padding           : array[$07..$0f] of byte;
          e_type            : word;
          e_machine         : word;
          e_version         : longword;
          e_entry           : longword;         { entrypoint }
          e_phoff           : longword;         { program header offset }
          e_shoff           : longword;         { sections header offset }
          e_flags           : longword;
          e_ehsize          : word;             { elf header size in bytes }
          e_phentsize       : word;             { size of an entry in the program header array }
          e_phnum           : word;             { 0..e_phnum-1 of entrys }
          e_shentsize       : word;             { size of an entry in sections header array }
          e_shnum           : word;             { 0..e_shnum-1 of entrys }
          e_shstrndx        : word;             { index of string section header }
        end;
        TElf32sechdr=packed record
          sh_name           : longword;
          sh_type           : longword;
          sh_flags          : longword;
          sh_addr           : longword;
          sh_offset         : longword;
          sh_size           : longword;
          sh_link           : longword;
          sh_info           : longword;
          sh_addralign      : longword;
          sh_entsize        : longword;
        end;
        TElf32proghdr=packed record
          p_type            : longword;
          p_offset          : longword;
          p_vaddr           : longword;
          p_paddr           : longword;
          p_filesz          : longword;
          p_memsz           : longword;
          p_flags           : longword;
          p_align           : longword;
        end;
        TElf32reloc=packed record
          address : longword;
          info    : longword; { bit 0-7: type, 8-31: symbol }
          addend  : longint;
        end;
        TElf32symbol=packed record
          st_name  : longword;
          st_value : longword;
          st_size  : longword;
          st_info  : byte; { bit 0-3: type, 4-7: bind }
          st_other : byte;
          st_shndx : word;
        end;
        TElf32Dyn=packed record
          d_tag: longword;
          case integer of
            0: (d_val: longword);
            1: (d_ptr: longword);
        end;


        telf64header=packed record
          magic             : array[0..3] of byte;
          file_class        : byte;
          data_encoding     : byte;
          file_version      : byte;
          padding           : array[$07..$0f] of byte;
          e_type            : word;
          e_machine         : word;
          e_version         : longword;
          e_entry           : qword;            { entrypoint }
          e_phoff           : qword;            { program header offset }
          e_shoff           : qword;            { sections header offset }
          e_flags           : longword;
          e_ehsize          : word;             { elf header size in bytes }
          e_phentsize       : word;             { size of an entry in the program header array }
          e_phnum           : word;             { 0..e_phnum-1 of entrys }
          e_shentsize       : word;             { size of an entry in sections header array }
          e_shnum           : word;             { 0..e_shnum-1 of entrys }
          e_shstrndx        : word;             { index of string section header }
        end;
        telf64sechdr=packed record
          sh_name           : longword;
          sh_type           : longword;
          sh_flags          : qword;
          sh_addr           : qword;
          sh_offset         : qword;
          sh_size           : qword;
          sh_link           : longword;
          sh_info           : longword;
          sh_addralign      : qword;
          sh_entsize        : qword;
        end;
        telf64proghdr=packed record
          p_type            : longword;
          p_flags           : longword;
          p_offset          : qword;
          p_vaddr           : qword;
          p_paddr           : qword;
          p_filesz          : qword;
          p_memsz           : qword;
          p_align           : qword;
        end;
        telf64reloc=packed record
          address : qword;
          info    : qword; { bit 0-31: type, 32-63: symbol }
          addend  : int64; { signed! }
        end;
        telf64symbol=packed record
          st_name  : longword;
          st_info  : byte; { bit 0-3: type, 4-7: bind }
          st_other : byte;
          st_shndx : word;
          st_value : qword;
          st_size  : qword;
        end;
        TElf64Dyn=packed record
          d_tag: qword;
          case integer of
            0: (d_val: qword);
            1: (d_ptr: qword);
        end;


{$ifdef cpu64bitaddr}
      const
        ELFCLASS = ELFCLASS64;
      type
        telfheader = telf64header;
        telfreloc = telf64reloc;
        telfsymbol = telf64symbol;
        telfsechdr = telf64sechdr;
        telfproghdr = telf64proghdr;
        telfdyn = telf64dyn;
{$else cpu64bitaddr}
      const
        ELFCLASS = ELFCLASS32;
      type
        telfheader = telf32header;
        telfreloc = telf32reloc;
        telfsymbol = telf32symbol;
        telfsechdr = telf32sechdr;
        telfproghdr = telf32proghdr;
        telfdyn = telf32dyn;
{$endif cpu64bitaddr}

{$ifdef x86_64}
      const
        relocs_use_addend:Boolean=True;
{$else x86_64}
      const
        relocs_use_addend:Boolean=False;
{$endif x86_64}

      procedure MayBeSwapHeader(var h : telf32header);
        begin
          if source_info.endian<>target_info.endian then
            with h do
              begin
                e_type:=swapendian(e_type);
                e_machine:=swapendian(e_machine);
                e_version:=swapendian(e_version);
                e_entry:=swapendian(e_entry);
                e_phoff:=swapendian(e_phoff);
                e_shoff:=swapendian(e_shoff);
                e_flags:=swapendian(e_flags);
                e_ehsize:=swapendian(e_ehsize);
                e_phentsize:=swapendian(e_phentsize);
                e_phnum:=swapendian(e_phnum);
                e_shentsize:=swapendian(e_shentsize);
                e_shnum:=swapendian(e_shnum);
                e_shstrndx:=swapendian(e_shstrndx);
              end;
        end;


      procedure MayBeSwapHeader(var h : telf64header);
        begin
          if source_info.endian<>target_info.endian then
            with h do
              begin
                e_type:=swapendian(e_type);
                e_machine:=swapendian(e_machine);
                e_version:=swapendian(e_version);
                e_entry:=swapendian(e_entry);
                e_phoff:=swapendian(e_phoff);
                e_shoff:=swapendian(e_shoff);
                e_flags:=swapendian(e_flags);
                e_ehsize:=swapendian(e_ehsize);
                e_phentsize:=swapendian(e_phentsize);
                e_phnum:=swapendian(e_phnum);
                e_shentsize:=swapendian(e_shentsize);
                e_shnum:=swapendian(e_shnum);
                e_shstrndx:=swapendian(e_shstrndx);
              end;
        end;


      procedure MayBeSwapHeader(var h : telf32proghdr);
        begin
          if source_info.endian<>target_info.endian then
            with h do
              begin
                p_align:=swapendian(p_align);
                p_filesz:=swapendian(p_filesz);
                p_flags:=swapendian(p_flags);
                p_memsz:=swapendian(p_memsz);
                p_offset:=swapendian(p_offset);
                p_paddr:=swapendian(p_paddr);
                p_type:=swapendian(p_type);
                p_vaddr:=swapendian(p_vaddr);
              end;
        end;


      procedure MayBeSwapHeader(var h : telf64proghdr);
        begin
          if source_info.endian<>target_info.endian then
            with h do
              begin
                p_align:=swapendian(p_align);
                p_filesz:=swapendian(p_filesz);
                p_flags:=swapendian(p_flags);
                p_memsz:=swapendian(p_memsz);
                p_offset:=swapendian(p_offset);
                p_paddr:=swapendian(p_paddr);
                p_type:=swapendian(p_type);
                p_vaddr:=swapendian(p_vaddr);
              end;
        end;


      procedure MaybeSwapSecHeader(var h : telf32sechdr);
        begin
          if source_info.endian<>target_info.endian then
            with h do
              begin
                sh_name:=swapendian(sh_name);
                sh_type:=swapendian(sh_type);
                sh_flags:=swapendian(sh_flags);
                sh_addr:=swapendian(sh_addr);
                sh_offset:=swapendian(sh_offset);
                sh_size:=swapendian(sh_size);
                sh_link:=swapendian(sh_link);
                sh_info:=swapendian(sh_info);
                sh_addralign:=swapendian(sh_addralign);
                sh_entsize:=swapendian(sh_entsize);
              end;
        end;


      procedure MaybeSwapSecHeader(var h : telf64sechdr);
        begin
          if source_info.endian<>target_info.endian then
            with h do
              begin
                sh_name:=swapendian(sh_name);
                sh_type:=swapendian(sh_type);
                sh_flags:=swapendian(sh_flags);
                sh_addr:=swapendian(sh_addr);
                sh_offset:=swapendian(sh_offset);
                sh_size:=swapendian(sh_size);
                sh_link:=swapendian(sh_link);
                sh_info:=swapendian(sh_info);
                sh_addralign:=swapendian(sh_addralign);
                sh_entsize:=swapendian(sh_entsize);
              end;
        end;


      procedure MaybeSwapElfSymbol(var h : telf32symbol);
        begin
          if source_info.endian<>target_info.endian then
            with h do
              begin
                st_name:=swapendian(st_name);
                st_value:=swapendian(st_value);
                st_size:=swapendian(st_size);
                st_shndx:=swapendian(st_shndx);
              end;
        end;


      procedure MaybeSwapElfSymbol(var h : telf64symbol);
        begin
          if source_info.endian<>target_info.endian then
            with h do
              begin
                st_name:=swapendian(st_name);
                st_value:=swapendian(st_value);
                st_size:=swapendian(st_size);
                st_shndx:=swapendian(st_shndx);
              end;
        end;


      procedure MaybeSwapElfReloc(var h : telf32reloc);
        begin
          if source_info.endian<>target_info.endian then
            with h do
              begin
                address:=swapendian(address);
                info:=swapendian(info);
                addend:=swapendian(addend);
              end;
        end;


      procedure MaybeSwapElfReloc(var h : telf64reloc);
        begin
          if source_info.endian<>target_info.endian then
            with h do
              begin
                address:=swapendian(address);
                info:=swapendian(info);
                addend:=swapendian(addend);
              end;
        end;


      procedure MaybeSwapElfDyn(var h : telf32dyn);
        begin
          if source_info.endian<>target_info.endian then
            with h do
              begin
                d_tag:=swapendian(d_tag);
                d_val:=swapendian(d_val);
              end;
        end;


      procedure MaybeSwapElfDyn(var h : telf64dyn);
        begin
          if source_info.endian<>target_info.endian then
            with h do
              begin
                d_tag:=swapendian(d_tag);
                d_val:=swapendian(d_val);
              end;
        end;


{****************************************************************************
                                Helpers
****************************************************************************}

    procedure encodesechdrflags(aoptions:TObjSectionOptions;out AshType:longint;out Ashflags:longint);
      begin
        { Section Type }
        AshType:=SHT_PROGBITS;
        if oso_strings in aoptions then
          AshType:=SHT_STRTAB
        else if not(oso_data in aoptions) then
          AshType:=SHT_NOBITS;
        { Section Flags }
        Ashflags:=0;
        if oso_load in aoptions then
          Ashflags:=Ashflags or SHF_ALLOC;
        if oso_executable in aoptions then
          Ashflags:=Ashflags or SHF_EXECINSTR;
        if oso_write in aoptions then
          Ashflags:=Ashflags or SHF_WRITE;
      end;


    procedure decodesechdrflags(AshType:longint;Ashflags:longint;out aoptions:TObjSectionOptions);
      begin
        aoptions:=[];
        { Section Type }
        if AshType<>SHT_NOBITS then
          include(aoptions,oso_data);
        if AshType=SHT_STRTAB then
          include(aoptions,oso_strings);
        { Section Flags }
        if Ashflags and SHF_ALLOC<>0 then
          include(aoptions,oso_load);
        if Ashflags and SHF_WRITE<>0 then
          include(aoptions,oso_write);
        if Ashflags and SHF_EXECINSTR<>0 then
          include(aoptions,oso_executable);
      end;


{****************************************************************************
                               TElfObjSection
****************************************************************************}

    constructor TElfObjSection.create(AList:TFPHashObjectList;const Aname:string;Aalign:shortint;Aoptions:TObjSectionOptions);
      begin
        inherited create(AList,Aname,Aalign,aoptions);
        secshidx:=0;
        shstridx:=0;
        encodesechdrflags(aoptions,shtype,shflags);
        shlink:=0;
        shinfo:=0;
        if name='.stab' then
          shentsize:=sizeof(TObjStabEntry);
      end;


    constructor TElfObjSection.create_ext(aobjdata:TObjData;const Aname:string;Ashtype,Ashflags,Ashlink,Ashinfo:longint;Aalign:shortint;Aentsize:longint);
      var
        aoptions : TObjSectionOptions;
      begin
        decodesechdrflags(Ashtype,Ashflags,aoptions);
        inherited create(aobjdata.ObjSectionList,Aname,Aalign,aoptions);
        objdata:=aobjdata;
        secshidx:=0;
        shstridx:=0;
        shtype:=AshType;
        shflags:=AshFlags;
        shlink:=Ashlink;
        shinfo:=Ashinfo;
        shentsize:=Aentsize;
      end;


{****************************************************************************
                            TElfObjData
****************************************************************************}

    constructor TElfObjData.create(const n:string);
      begin
        inherited create(n);
        CObjSection:=TElfObjSection;
        { we need at least the following sections }
        createsection(sec_code);
        { always a non-PIC data section (will remain empty if doing PIC) }
        createsection('.data',sectiontype2align(sec_data),sectiontype2options(sec_data));
        createsection(sec_bss);
        if (cs_create_pic in current_settings.moduleswitches) and
           not(target_info.system in systems_darwin) then
          createsection(sec_data);
        if tf_section_threadvars in target_info.flags then
          createsection(sec_threadvar);
        if (tf_needs_dwarf_cfi in target_info.flags) and
           (af_supports_dwarf in target_asm.flags) then
             createsection(sec_debug_frame);
      end;


    function TElfObjData.sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;
      const
        secnames : array[TAsmSectiontype] of string[length('__DATA, __datacoal_nt,coalesced')] = ('','',
{$ifdef userodata}
          '.text','.data','.data','.rodata','.bss','.threadvar',
{$else userodata}
          '.text','.data','.data','.data','.bss','.threadvar',
{$endif userodata}
          '.pdata',
          '.text', { darwin stubs }
          '__DATA,__nl_symbol_ptr',
          '__DATA,__la_symbol_ptr',
          '__DATA,__mod_init_func',
          '__DATA,__mod_term_func',
          '.stab','.stabstr',
          '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
          '.eh_frame',
          '.debug_frame','.debug_info','.debug_line','.debug_abbrev',
          '.fpc',
          '.toc',
          '.init',
          '.fini',
          '.objc_class',
          '.objc_meta_class',
          '.objc_cat_cls_meth',
          '.objc_cat_inst_meth',
          '.objc_protocol',
          '.objc_string_object',
          '.objc_cls_meth',
          '.objc_inst_meth',
          '.objc_cls_refs',
          '.objc_message_refs',
          '.objc_symbols',
          '.objc_category',
          '.objc_class_vars',
          '.objc_instance_vars',
          '.objc_module_info',
          '.objc_class_names',
          '.objc_meth_var_types',
          '.objc_meth_var_names',
          '.objc_selector_strs',
          '.objc_protocol_ext',
          '.objc_class_ext',
          '.objc_property',
          '.objc_image_info',
          '.objc_cstring_object',
          '.objc_sel_fixup',
          '__DATA,__objc_data',
          '__DATA,__objc_const',
          '.objc_superrefs',
          '__DATA, __datacoal_nt,coalesced',
          '.objc_classlist',
          '.objc_nlclasslist',
          '.objc_catlist',
          '.obcj_nlcatlist',
          '.objc_protolist'
        );
        secnames_pic : array[TAsmSectiontype] of string[length('__DATA, __datacoal_nt,coalesced')] = ('','',
          '.text',
          '.data.rel',
          '.data.rel',
          '.data.rel',
          '.bss',
          '.threadvar',
          '.pdata',
          '', { stubs }
          '__DATA,__nl_symbol_ptr',
          '__DATA,__la_symbol_ptr',
          '__DATA,__mod_init_func',
          '__DATA,__mod_term_func',
          '.stab',
          '.stabstr',
          '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
          '.eh_frame',
          '.debug_frame','.debug_info','.debug_line','.debug_abbrev',
          '.fpc',
          '.toc',
          '.init',
          '.fini',
          '.objc_class',
          '.objc_meta_class',
          '.objc_cat_cls_meth',
          '.objc_cat_inst_meth',
          '.objc_protocol',
          '.objc_string_object',
          '.objc_cls_meth',
          '.objc_inst_meth',
          '.objc_cls_refs',
          '.objc_message_refs',
          '.objc_symbols',
          '.objc_category',
          '.objc_class_vars',
          '.objc_instance_vars',
          '.objc_module_info',
          '.objc_class_names',
          '.objc_meth_var_types',
          '.objc_meth_var_names',
          '.objc_selector_strs',
          '.objc_protocol_ext',
          '.objc_class_ext',
          '.objc_property',
          '.objc_image_info',
          '.objc_cstring_object',
          '.objc_sel_fixup',
          '__DATA,__objc_data',
          '__DATA,__objc_const',
          '.objc_superrefs',
          '__DATA, __datacoal_nt,coalesced',
          '.objc_classlist',
          '.objc_nlclasslist',
          '.objc_catlist',
          '.obcj_nlcatlist',
          '.objc_protolist'
        );
      var
        sep : string[3];
        secname : string;
      begin
        { section type user gives the user full controll on the section name }
        if atype=sec_user then
          result:=aname
        else
          begin
            if (cs_create_pic in current_settings.moduleswitches) and
               not(target_info.system in systems_darwin) then
              secname:=secnames_pic[atype]
            else
              secname:=secnames[atype];
            if (atype=sec_fpc) and (Copy(aname,1,3)='res') then
              begin
                result:=secname+'.'+aname;
                exit;
              end;
            if create_smartlink_sections and (aname<>'') then
              begin
                case aorder of
                  secorder_begin :
                    sep:='.b_';
                  secorder_end :
                    sep:='.z_';
                  else
                    sep:='.n_';
                end;
                result:=secname+sep+aname
              end
            else
              result:=secname;
          end;
      end;


    procedure TElfObjData.CreateDebugSections;
      begin
        if target_dbg.id=dbg_stabs then
          begin
            stabssec:=createsection(sec_stab);
            stabstrsec:=createsection(sec_stabstr);
          end;
      end;


    procedure TElfObjData.writereloc(data:aint;len:aword;p:TObjSymbol;reltype:TObjRelocationType);
      var
        symaddr : aint;
        objreloc: TObjRelocation;
      begin
        if CurrObjSec=nil then
          internalerror(200403292);
        objreloc:=nil;
        if assigned(p) then
         begin
           { real address of the symbol }
           symaddr:=p.address;
           { Local ObjSymbols can be resolved already or need a section reloc }
           if (p.bind=AB_LOCAL) and
              (reltype in [RELOC_RELATIVE,RELOC_ABSOLUTE{$ifdef x86_64},RELOC_ABSOLUTE32{$endif x86_64}]) then
             begin
               { For a reltype relocation in the same section the
                 value can be calculated }
               if (p.objsection=CurrObjSec) and
                  (reltype=RELOC_RELATIVE) then
                 inc(data,symaddr-len-CurrObjSec.Size)
               else
                 begin
                   objreloc:=TObjRelocation.CreateSection(CurrObjSec.Size,p.objsection,reltype);
                   CurrObjSec.ObjRelocations.Add(objreloc);
                   inc(data,symaddr);
                 end;
             end
           else
             begin
               objreloc:=TObjRelocation.CreateSymbol(CurrObjSec.Size,p,reltype);
               CurrObjSec.ObjRelocations.Add(objreloc);
               { If target is a local label and it isn't handled above,
                 patch its type in order to get it written to symtable.
                 This may happen e.g. when taking address of Pascal label in PIC mode. }
               if (p.bind=AB_LOCAL) and (p.typ=AT_LABEL) then
                 p.typ:=AT_ADDR;
            end;
         end;
        if assigned(objreloc) then
          begin
            objreloc.size:=len;
            if reltype in [RELOC_RELATIVE,RELOC_PLT32{$ifdef x86_64},RELOC_GOTPCREL{$endif}] then
              dec(data,len);
            if relocs_use_addend then
              begin
                objreloc.orgsize:=data;
                data:=0;
              end;
          end;
        CurrObjSec.write(data,len);
      end;


{****************************************************************************
                            TElfSymtab
****************************************************************************}

    const
      symsecnames: array[boolean] of string[8] = ('.symtab','.dynsym');
      strsecnames: array[boolean] of string[8] = ('.strtab','.dynstr');
      symsectypes: array[boolean] of longint   = (SHT_SYMTAB,SHT_DYNSYM);
      symsecattrs: array[boolean] of longint   = (0,SHF_ALLOC);


    constructor TElfSymtab.create(aObjData:TObjData;aKind:TElfSymtabKind);
      var
        dyn:boolean;
      begin
        dyn:=(aKind=esk_dyn);
        create_ext(aObjData,symsecnames[dyn],symsectypes[dyn],symsecattrs[dyn],0,0,sizeof(pint),sizeof(TElfSymbol));
        fstrsec:=TElfObjSection.create_ext(aObjData,strsecnames[dyn],SHT_STRTAB,symsecattrs[dyn],0,0,1,0);
        fstrsec.writestr(#0);
        writezeros(sizeof(TElfSymbol));
        symidx:=1;
        shinfo:=1;
        kind:=aKind;
      end;

    procedure TElfSymtab.writeInternalSymbol(astridx:longint;ainfo:byte;ashndx:word);
      var
        elfsym:TElfSymbol;
      begin
        fillchar(elfsym,sizeof(elfsym),0);
        elfsym.st_name:=astridx;
        elfsym.st_info:=ainfo;
        elfsym.st_shndx:=ashndx;
        inc(symidx);
        inc(shinfo);
        MaybeSwapElfSymbol(elfsym);
        write(elfsym,sizeof(elfsym));
      end;

    procedure TElfSymtab.writeSymbol(objsym:TObjSymbol);
      var
        elfsym:TElfSymbol;
      begin
        fillchar(elfsym,sizeof(elfsym),0);
        { symbolname, write the #0 separate to overcome 255+1 char not possible }
        elfsym.st_name:=fstrsec.writestr(objsym.name);
        fstrsec.writestr(#0);
        elfsym.st_size:=objsym.size;
        case objsym.bind of
          AB_LOCAL :
            begin
              elfsym.st_value:=objsym.address;
              elfsym.st_info:=STB_LOCAL shl 4;
              inc(shinfo);
            end;
          AB_COMMON :
            begin
              elfsym.st_value:=$10;            { ?? should not be hardcoded }
              elfsym.st_info:=STB_GLOBAL shl 4;
              elfsym.st_shndx:=SHN_COMMON;
            end;
          AB_EXTERNAL :
            elfsym.st_info:=STB_GLOBAL shl 4;
          AB_WEAK_EXTERNAL :
            elfsym.st_info:=STB_WEAK shl 4;
          AB_GLOBAL :
            begin
              elfsym.st_value:=objsym.address;
              elfsym.st_info:=STB_GLOBAL shl 4;
            end;
        end;
        if (objsym.bind<>AB_EXTERNAL) {and
           not(assigned(objsym.objsection) and
           not(oso_data in objsym.objsection.secoptions))} then
          begin
            case objsym.typ of
              AT_FUNCTION :
                elfsym.st_info:=elfsym.st_info or STT_FUNC;
              AT_DATA :
                elfsym.st_info:=elfsym.st_info or STT_OBJECT;
            end;
          end;
        if objsym.bind<>AB_COMMON then
          begin
            if kind<>esk_obj then
              begin
                { TODO }
              end
            else
              begin
                if assigned(objsym.objsection) then
                  elfsym.st_shndx:=TElfObjSection(objsym.objsection).secshidx
                else
                  elfsym.st_shndx:=SHN_UNDEF;
                objsym.symidx:=symidx;
              end;
          end;
        inc(symidx);
        MaybeSwapElfSymbol(elfsym);
        write(elfsym,sizeof(TElfSymbol));
      end;

{****************************************************************************
                            TElfObjectOutput
****************************************************************************}

    constructor TElfObjectOutput.create(AWriter:TObjectWriter);
      begin
        inherited Create(AWriter);
        CObjData:=TElfObjData;
      end;


    procedure TElfObjectOutput.createrelocsection(s:TElfObjSection;data:TObjData);
      var
        i    : longint;
        rel  : telfreloc;
        objreloc : TObjRelocation;
        relsym,
        reltyp   : longint;
        relocsect : TElfObjSection;
      begin
        with data do
         begin
           { create the reloc section }
           if relocs_use_addend then
             relocsect:=TElfObjSection.create_ext(data,'.rela'+s.name,SHT_RELA,0,symtabsect.secshidx,s.secshidx,4,3*sizeof(pint))
           else
             relocsect:=TElfObjSection.create_ext(data,'.rel'+s.name,SHT_REL,0,symtabsect.secshidx,s.secshidx,4,2*sizeof(pint));
           { add the relocations }
           for i:=0 to s.Objrelocations.count-1 do
             begin
               objreloc:=TObjRelocation(s.Objrelocations[i]);
               fillchar(rel,sizeof(rel),0);
               rel.address:=objreloc.dataoffset;
               rel.addend:=objreloc.orgsize;

               { when things settle down, we can create processor specific
                 derived classes }
               case objreloc.typ of
{$ifdef i386}
                 RELOC_RELATIVE :
                   reltyp:=R_386_PC32;
                 RELOC_ABSOLUTE :
                   reltyp:=R_386_32;
                 RELOC_GOT32 :
                   reltyp:=R_386_GOT32;
                 RELOC_GOTPC :
                   reltyp:=R_386_GOTPC;
                 RELOC_PLT32 :
                   reltyp:=R_386_PLT32;
{$endif i386}
{$ifdef sparc}
                 RELOC_ABSOLUTE :
                   reltyp:=R_SPARC_32;
{$endif sparc}
{$ifdef x86_64}
    { Note: 8 and 16-bit relocations are known to be non-conformant with
      AMD64 ABI, so they aren't handled. }
                 RELOC_RELATIVE :
                   if objreloc.size=8 then
                     reltyp:=R_X86_64_PC64
                   else if objreloc.size=4 then
                     reltyp:=R_X86_64_PC32
                   else
                     InternalError(2012061900);
                 RELOC_ABSOLUTE :
                   if objreloc.size=8 then
                     reltyp:=R_X86_64_64
                   else if objreloc.size=4 then
                     reltyp:=R_X86_64_32
                   else
                     InternalError(2012061901);
                 RELOC_ABSOLUTE32 :
                   reltyp:=R_X86_64_32S;
                 RELOC_GOTPCREL :
                   reltyp:=R_X86_64_GOTPCREL;
                 RELOC_PLT32 :
                   reltyp:=R_X86_64_PLT32;
{$endif x86_64}
                 else
                   internalerror(200602261);
               end;

               { Symbol }
               if assigned(objreloc.symbol) then
                 begin
                   if objreloc.symbol.symidx=-1 then
                     begin
                       writeln(objreloc.symbol.Name);
                       internalerror(200603012);
                     end;
                   relsym:=objreloc.symbol.symidx;
                 end
               else
                 begin
                   if objreloc.objsection<>nil then
                     relsym:=objreloc.objsection.secsymidx
                   else
                     relsym:=SHN_UNDEF;
                 end;
{$ifdef cpu64bitaddr}
               rel.info:=(qword(relsym) shl 32) or reltyp;
{$else cpu64bitaddr}
               rel.info:=(relsym shl 8) or reltyp;
{$endif cpu64bitaddr}
               { write reloc }
               { ElfXX_Rel is essentially ElfXX_Rela without the addend field. }
               MaybeSwapElfReloc(rel);
               relocsect.write(rel,relocsect.shentsize);
             end;
         end;
      end;


    procedure TElfObjectOutput.section_write_symbol(p:TObject;arg:pointer);
      begin
        { Must not write symbols for internal sections like .symtab }
        { TODO: maybe use inclusive list of section types instead }
        if (TElfObjSection(p).shtype in [SHT_SYMTAB,SHT_STRTAB,SHT_REL,SHT_RELA]) then
          exit;
        TObjSection(p).secsymidx:=symtabsect.symidx;
        symtabsect.writeInternalSymbol(0,STT_SECTION,TElfObjSection(p).secshidx);
      end;


    procedure TElfObjectOutput.createsymtab(data: TObjData);
      var
        i      : longint;
        objsym : TObjSymbol;
      begin
        with data do
         begin
           { filename entry }
           symtabsect.writeInternalSymbol(1,STT_FILE,SHN_ABS);
           { section }
           ObjSectionList.ForEachCall(@section_write_symbol,nil);
           { First the Local Symbols, this is required by ELF. The localsyms
             count stored in shinfo is used to skip the local symbols
             when traversing the symtab }
           for i:=0 to ObjSymbolList.Count-1 do
             begin
               objsym:=TObjSymbol(ObjSymbolList[i]);
               if (objsym.bind=AB_LOCAL) and (objsym.typ<>AT_LABEL) then
                 symtabsect.WriteSymbol(objsym);
             end;
           { Global Symbols }
           for i:=0 to ObjSymbolList.Count-1 do
             begin
               objsym:=TObjSymbol(ObjSymbolList[i]);
               if (objsym.bind<>AB_LOCAL) then
                 symtabsect.WriteSymbol(objsym);
             end;
           { update the .symtab section header }
           symtabsect.shlink:=TElfObjSection(symtabsect.fstrsec).secshidx;
         end;
      end;


    procedure TElfObjectOutput.section_write_sh_string(p:TObject;arg:pointer);
      begin
        TElfObjSection(p).shstridx:=shstrtabsect.writestr(TObjSection(p).name+#0);
      end;


    procedure TElfObjectOutput.createshstrtab(data: TObjData);
      begin
        with data do
         begin
           shstrtabsect.writestr(#0);
           ObjSectionList.ForEachCall(@section_write_sh_string,nil);
         end;
      end;


    procedure TElfObjectOutput.writesectionheader(s:TElfObjSection);
      var
        sechdr : telfsechdr;
      begin
        fillchar(sechdr,sizeof(sechdr),0);
        sechdr.sh_name:=s.shstridx;
        sechdr.sh_type:=s.shtype;
        sechdr.sh_flags:=s.shflags;
        sechdr.sh_offset:=s.datapos;
        sechdr.sh_size:=s.Size;
        sechdr.sh_link:=s.shlink;
        sechdr.sh_info:=s.shinfo;
        sechdr.sh_addralign:=s.secalign;
        sechdr.sh_entsize:=s.shentsize;
        MaybeSwapSecHeader(sechdr);
        writer.write(sechdr,sizeof(sechdr));
      end;


    procedure TElfObjectOutput.section_count_sections(p:TObject;arg:pointer);
      begin
        TElfObjSection(p).secshidx:=pword(arg)^;
        inc(pword(arg)^);
      end;


    procedure TElfObjectOutput.section_create_relocsec(p:TObject;arg:pointer);
      begin
        if (TElfObjSection(p).ObjRelocations.count>0) then
          createrelocsection(TElfObjSection(p),TObjData(arg));
      end;


    procedure TElfObjectOutput.section_write_sechdr(p:TObject;arg:pointer);
      begin
        writesectionheader(TElfObjSection(p));
      end;


    function TElfObjectOutput.writedata(data:TObjData):boolean;
      var
        header : telfheader;
        shoffset,
        datapos   : aword;
        nsections : word;
      begin
        result:=false;
        with data do
         begin
           { default sections }
           symtabsect:=TElfSymtab.create(data,esk_obj);
           shstrtabsect:=TElfObjSection.create_ext(data,'.shstrtab',SHT_STRTAB,0,0,0,1,0);
           { "no executable stack" marker for Linux }
           if (target_info.system in systems_linux) and
              not(cs_executable_stack in current_settings.moduleswitches) then
             TElfObjSection.create_ext(data,'.note.GNU-stack',SHT_PROGBITS,0,0,0,1,0);
           { insert filename as first in strtab }
           symtabsect.fstrsec.writestr(ExtractFileName(current_module.mainsource));
           symtabsect.fstrsec.writestr(#0);
           { calc amount of sections we have }
           nsections:=1;
           { also create the index in the section header table }
           ObjSectionList.ForEachCall(@section_count_sections,@nsections);
           { create .symtab and .strtab }
           createsymtab(data);
           { Create the relocation sections, this needs valid secidx and symidx }
           ObjSectionList.ForEachCall(@section_create_relocsec,data);
           { recalc nsections to incude the reloc sections }
           nsections:=1;
           ObjSectionList.ForEachCall(@section_count_sections,@nsections);
           { create .shstrtab }
           createshstrtab(data);

           { Calculate the filepositions }
           datapos:=$40; { elfheader + alignment }
           { section data }
           layoutsections(datapos);
           { section headers }
           shoffset:=datapos;
           inc(datapos,(nsections+1)*sizeof(telfsechdr));

           { Write ELF Header }
           fillchar(header,sizeof(header),0);
           header.magic[0]:=$7f; { = #127'ELF' }
           header.magic[1]:=$45;
           header.magic[2]:=$4c;
           header.magic[3]:=$46;
           header.file_class:=ELFCLASS;
           if target_info.endian=endian_big then
             header.data_encoding:=2
           else
             header.data_encoding:=1;

           header.file_version:=1;
           header.e_type:=ET_REL;
           header.e_machine:=ELFMACHINE;
{$ifdef arm}
           if (current_settings.fputype=fpu_soft) then
             header.e_flags:=$600;
{$endif arm}
           header.e_version:=1;
           header.e_shoff:=shoffset;
           header.e_shstrndx:=shstrtabsect.secshidx;

           header.e_shnum:=nsections;
           header.e_ehsize:=sizeof(telfheader);
           header.e_shentsize:=sizeof(telfsechdr);
           MaybeSwapHeader(header);
           writer.write(header,sizeof(header));
           writer.writezeros($40-sizeof(header)); { align }
           { Sections }
           WriteSectionContent(data);
           { section headers, start with an empty header for sh_undef }
           writer.writezeros(sizeof(telfsechdr));
           ObjSectionList.ForEachCall(@section_write_sechdr,nil);
         end;
        result:=true;
      end;


{****************************************************************************
                               TELFAssembler
****************************************************************************}

    constructor TElfAssembler.Create(smart:boolean);
      begin
        inherited Create(smart);
        CObjOutput:=TElfObjectOutput;
      end;


{*****************************************************************************
                                  Initialize
*****************************************************************************}

{$ifdef i386}
     const
       as_i386_elf32_info : tasminfo =
          (
            id     : as_i386_elf32;
            idtxt  : 'ELF';
            asmbin : '';
            asmcmd : '';
            supported_targets : [system_i386_linux,system_i386_beos,
                                 system_i386_freebsd,system_i386_haiku,
                                 system_i386_openbsd,system_i386_netbsd,
                                 system_i386_Netware,system_i386_netwlibc,
	                         system_i386_solaris,system_i386_embedded];
            flags : [af_outputbinary,af_smartlink_sections,af_supports_dwarf];
            labelprefix : '.L';
            comment : '';
            dollarsign: '$';
          );
{$endif i386}
{$ifdef x86_64}
     const
       as_x86_64_elf64_info : tasminfo =
          (
            id     : as_x86_64_elf64;
            idtxt  : 'ELF';
            asmbin : '';
            asmcmd : '';
            supported_targets : [system_x86_64_linux,system_x86_64_freebsd,
                                 system_x86_64_openbsd,system_x86_64_netbsd];
            flags : [af_outputbinary,af_smartlink_sections,af_supports_dwarf];
            labelprefix : '.L';
            comment : '';
            dollarsign: '$';
          );
{$endif x86_64}
{$ifdef sparc}
     const
       as_sparc_elf32_info : tasminfo =
          (
            id     : as_sparc_elf32;
            idtxt  : 'ELF';
            asmbin : '';
            asmcmd : '';
            supported_targets : [];
//            flags : [af_outputbinary,af_smartlink_sections];
            flags : [af_outputbinary,af_supports_dwarf];
            labelprefix : '.L';
            comment : '';
            dollarsign: '$';
          );
{$endif sparc}


initialization
{$ifdef i386}
  RegisterAssembler(as_i386_elf32_info,TElfAssembler);
{$endif i386}
{$ifdef sparc}
  RegisterAssembler(as_sparc_elf32_info,TElfAssembler);
{$endif sparc}
{$ifdef x86_64}
  RegisterAssembler(as_x86_64_elf64_info,TElfAssembler);
{$endif x86_64}
end.