freepascal.compiler/compiler/ogcoff.pas

{
    Copyright (c) 1998-2006 by Peter Vreman

    Contains the binary coff/PE reader and 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 ogcoff;

{$i fpcdefs.inc}

interface

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

    const
       PE_DATADIR_ENTRIES = 16;

    type
       tcoffpedatadir = packed record
         vaddr : longword;
         size  : longword;
       end;
       tcoffheader = packed record
         mach   : word;
         nsects : word;
         time   : longword;
         sympos : longword;
         syms   : longword;
         opthdr : word;
         flag   : word;
       end;
       tcoffpeoptheader = packed record
         Magic : word;
         MajorLinkerVersion : byte;
         MinorLinkerVersion : byte;
         tsize : longword;
         dsize : longword;
         bsize : longword;
         entry : longword;
         text_start : longword;
{$ifndef cpu64bitaddr}
         data_start : longword;
{$endif cpu64bitaddr}
         ImageBase : aword;
         SectionAlignment : longword;
         FileAlignment : longword;
         MajorOperatingSystemVersion : word;
         MinorOperatingSystemVersion : word;
         MajorImageVersion : word;
         MinorImageVersion : word;
         MajorSubsystemVersion : word;
         MinorSubsystemVersion : word;
         Win32Version : longword;
         SizeOfImage : longword;
         SizeOfHeaders : longword;
         CheckSum : longword;
         Subsystem : word;
         DllCharacteristics : word;
         SizeOfStackReserve : aword;
         SizeOfStackCommit : aword;
         SizeOfHeapReserve : aword;
         SizeOfHeapCommit : aword;
         LoaderFlags : longword;          { This field is obsolete }
         NumberOfRvaAndSizes : longword;
         DataDirectory : array[0..PE_DATADIR_ENTRIES-1] of tcoffpedatadir;
       end;
       tcoffsechdr = packed record
         name     : array[0..7] of char;
         vsize    : longword;
         rvaofs   : longword;
         datasize : longword;
         datapos  : longword;
         relocpos : longword;
         lineno1  : longword;
         nrelocs  : word;
         lineno2  : word;
         flags    : longword;
       end;

       TCoffObjSection = class(TObjSection)
       private
         orgmempos,
         coffrelocs,
         coffrelocpos : aword;
       public
         constructor create(AList:TFPHashObjectList;const Aname:string;Aalign:shortint;Aoptions:TObjSectionOptions);override;
         procedure addsymsizereloc(ofs:aword;p:TObjSymbol;symsize:aword;reloctype:TObjRelocationType);
       end;

       TCoffObjData = class(TObjData)
       private
         win32      : boolean;
{$ifdef arm}
         eVCobj     : boolean;
{$endif arm}
       public
         constructor createcoff(const n:string;awin32:boolean;acObjSection:TObjSectionClass);
         procedure CreateDebugSections;override;
         function  sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;override;
         procedure writereloc(data:aint;len:aword;p:TObjSymbol;reloctype:TObjRelocationType);override;
       end;

       TDJCoffObjData = class(TCoffObjData)
         constructor create(const n:string);override;
       end;

       TPECoffObjData = class(TCoffObjData)
         constructor create(const n:string);override;
       end;

       TCoffObjOutput = class(tObjOutput)
       private
         win32   : boolean;
         symidx  : longint;
         FCoffSyms,
         FCoffStrs : tdynamicarray;
         procedure write_symbol(const name:string;value:aword;section:smallint;typ,aux:byte);
         procedure section_write_symbol(p:TObject;arg:pointer);
         procedure section_write_relocs(p:TObject;arg:pointer);
         procedure create_symbols(data:TObjData);
         procedure section_set_reloc_datapos(p:TObject;arg:pointer);
         procedure section_write_header(p:TObject;arg:pointer);
       protected
         function writedata(data:TObjData):boolean;override;
       public
         constructor createcoff(AWriter:TObjectWriter;awin32:boolean);
         destructor destroy;override;
       end;

       TDJCoffObjOutput = class(TCoffObjOutput)
         constructor create(AWriter:TObjectWriter);override;
       end;

       TPECoffObjOutput = class(TCoffObjOutput)
         constructor create(AWriter:TObjectWriter);override;
       end;

       TCoffObjInput = class(tObjInput)
       private
         FCoffsyms : tdynamicarray;
         FCoffStrs : PChar;
         FCoffStrSize: longword;
         { Convert symidx -> TObjSymbol }
         FSymTbl   : ^TObjSymbolArray;
         { Convert secidx -> TObjSection }
         FSecCount : smallint;
         FSecTbl   : ^TObjSectionArray;
         win32     : boolean;
         function  GetSection(secidx:longint):TObjSection;
         function  Read_str(strpos:longword):string;
         procedure read_relocs(s:TCoffObjSection);
         procedure read_symbols(objdata:TObjData);
         procedure ObjSections_read_relocs(p:TObject;arg:pointer);
       public
         constructor createcoff(awin32:boolean);
         destructor destroy;override;
         function  ReadObjData(AReader:TObjectreader;objdata:TObjData):boolean;override;
       end;

       TDJCoffObjInput = class(TCoffObjInput)
         constructor create;override;
       end;

       TPECoffObjInput = class(TCoffObjInput)
         constructor create;override;
       end;

       TCoffexeoutput = class(texeoutput)
       private
         FCoffStrs : tdynamicarray;
         win32     : boolean;
         nsects    : word;
         nsyms,
         sympos    : aword;
         datapos_offset: longword;
         function  totalheadersize:longword;
         procedure ExeSectionList_pass2_header(p:TObject;arg:pointer);
         procedure write_symbol(const name:string;value:aword;section:smallint;typ,aux:byte);
         procedure globalsyms_write_symbol(p:TObject;arg:pointer);
         procedure ExeSectionList_write_header(p:TObject;arg:pointer);
       protected
         function writedata:boolean;override;
         procedure Order_ObjSectionList(ObjSectionList : TFPObjectList;const aPattern:string);override;
         procedure DoRelocationFixup(objsec:TObjSection);override;
       public
         constructor createcoff(awin32:boolean);
         procedure MemPos_Header;override;
         procedure DataPos_Header;override;
         procedure DataPos_Symbols;override;
       end;

       TDJCoffexeoutput = class(TCoffexeoutput)
         constructor create;override;
         procedure MemPos_Header;override;
       end;

       TPECoffexeoutput = class(TCoffexeoutput)
       private
         idatalabnr : longword;
         FRelocsGenerated : boolean;
         procedure GenerateRelocs;
       public
         constructor create;override;
         procedure GenerateLibraryImports(ImportLibraryList:TFPHashObjectList);override;
         procedure Order_End;override;
         procedure MemPos_ExeSection(const aname:string);override;
       end;

       TObjSymbolArray = array[0..high(word)] of TObjSymbol;
       TObjSectionArray = array[0..high(smallint)] of TObjSection;

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

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


    type
      Treaddllproc = procedure(const dllname,funcname:string) of object;

    const
{$ifdef i386}
       COFF_MAGIC       = $14c;
       COFF_OPT_MAGIC   = $10b;
       TLSDIR_SIZE      = $18;
{$endif i386}
{$ifdef arm}
       COFF_MAGIC       = $1c0;
       COFF_OPT_MAGIC   = $10b;
       TLSDIR_SIZE      = $18;
{$endif arm}
{$ifdef x86_64}
       COFF_MAGIC       = $8664;
       COFF_OPT_MAGIC   = $20b;
       TLSDIR_SIZE      = $28;
{$endif x86_64}
    function ReadDLLImports(const dllname:string;readdllproc:Treaddllproc):boolean;

implementation

    uses
{$ifdef win32}
       Windows,
{$endif win32}
       SysUtils,
       cutils,verbose,globals,
       fmodule,aasmtai,aasmdata,
       ogmap,
       version
       ;

    const
       COFF_FLAG_NORELOCS = $0001;
       COFF_FLAG_EXE      = $0002;
       COFF_FLAG_NOLINES  = $0004;
       COFF_FLAG_NOLSYMS  = $0008;
       COFF_FLAG_AR16WR   = $0080; { 16bit little endian }
       COFF_FLAG_AR32WR   = $0100; { 32bit little endian }
       COFF_FLAG_AR32W    = $0200; { 32bit big endian }
       COFF_FLAG_DLL      = $2000;

       COFF_SYM_GLOBAL   = 2;
       COFF_SYM_LOCAL    = 3;
       COFF_SYM_LABEL    = 6;
       COFF_SYM_FUNCTION = 101;
       COFF_SYM_FILE     = 103;
       COFF_SYM_SECTION  = 104;

       COFF_STYP_REG    = $0000; { "regular": allocated, relocated, loaded }
       COFF_STYP_DSECT  = $0001; { "dummy":  relocated only }
       COFF_STYP_NOLOAD = $0002; { "noload": allocated, relocated, not loaded }
       COFF_STYP_GROUP  = $0004; { "grouped": formed of input sections }
       COFF_STYP_PAD    = $0008;
       COFF_STYP_COPY   = $0010;
       COFF_STYP_TEXT   = $0020;
       COFF_STYP_DATA   = $0040;
       COFF_STYP_BSS    = $0080;
       COFF_STYP_INFO   = $0200;
       COFF_STYP_OVER   = $0400;
       COFF_STYP_LIB    = $0800;

       PE_SUBSYSTEM_NATIVE         = 1;
       PE_SUBSYSTEM_WINDOWS_GUI    = 2;
       PE_SUBSYSTEM_WINDOWS_CUI    = 3;
       PE_SUBSYSTEM_WINDOWS_CE_GUI = 9;

       PE_FILE_RELOCS_STRIPPED         = $0001;
       PE_FILE_EXECUTABLE_IMAGE        = $0002;
       PE_FILE_LINE_NUMS_STRIPPED      = $0004;
       PE_FILE_LOCAL_SYMS_STRIPPED     = $0008;
       PE_FILE_AGGRESSIVE_WS_TRIM      = $0010;
       PE_FILE_LARGE_ADDRESS_AWARE     = $0020;
       PE_FILE_16BIT_MACHINE           = $0040;
       PE_FILE_BYTES_REVERSED_LO       = $0080;
       PE_FILE_32BIT_MACHINE           = $0100;
       PE_FILE_DEBUG_STRIPPED          = $0200;
       PE_FILE_REMOVABLE_RUN_FROM_SWAP = $0400;
       PE_FILE_NET_RUN_FROM_SWAP       = $0800;
       PE_FILE_SYSTEM                  = $1000;
       PE_FILE_DLL                     = $2000;
       PE_FILE_UP_SYSTEM_ONLY          = $4000;
       PE_FILE_BYTES_REVERSED_HI       = $8000;

       PE_SCN_CNT_CODE               = $00000020; { Section contains code. }
       PE_SCN_CNT_INITIALIZED_DATA   = $00000040; { Section contains initialized data. }
       PE_SCN_CNT_UNINITIALIZED_DATA = $00000080; { Section contains uninitialized data. }
       PE_SCN_LNK_OTHER              = $00000100; { Reserved. }
       PE_SCN_LNK_INFO               = $00000200; { Section contains comments or some other type of information. }
       PE_SCN_LNK_REMOVE             = $00000800; { Section contents will not become part of image. }
       PE_SCN_LNK_COMDAT             = $00001000; { Section contents comdat. }
       PE_SCN_MEM_FARDATA            = $00008000;
       PE_SCN_MEM_PURGEABLE          = $00020000;
       PE_SCN_MEM_16BIT              = $00020000;
       PE_SCN_MEM_LOCKED             = $00040000;
       PE_SCN_MEM_PRELOAD            = $00080000;
       PE_SCN_ALIGN_MASK             = $00f00000;
       PE_SCN_ALIGN_1BYTES           = $00100000;
       PE_SCN_ALIGN_2BYTES           = $00200000;
       PE_SCN_ALIGN_4BYTES           = $00300000;
       PE_SCN_ALIGN_8BYTES           = $00400000;
       PE_SCN_ALIGN_16BYTES          = $00500000; { Default alignment if no others are specified. }
       PE_SCN_ALIGN_32BYTES          = $00600000;
       PE_SCN_ALIGN_64BYTES          = $00700000;
       PE_SCN_LNK_NRELOC_OVFL        = $01000000; { Section contains extended relocations. }
       PE_SCN_MEM_NOT_CACHED         = $04000000; { Section is not cachable.               }
       PE_SCN_MEM_NOT_PAGED          = $08000000; { Section is not pageable.               }
       PE_SCN_MEM_SHARED             = $10000000; { Section is shareable.                  }
       PE_SCN_MEM_DISCARDABLE        = $02000000;
       PE_SCN_MEM_EXECUTE            = $20000000;
       PE_SCN_MEM_READ               = $40000000;
       PE_SCN_MEM_WRITE              = $80000000;

       PE_DATADIR_EDATA = 0;
       PE_DATADIR_IDATA = 1;
       PE_DATADIR_RSRC = 2;
       PE_DATADIR_PDATA = 3;
       PE_DATADIR_SECURITY = 4;
       PE_DATADIR_RELOC = 5;
       PE_DATADIR_DEBUG = 6;
       PE_DATADIR_DESCRIPTION = 7;
       PE_DATADIR_SPECIAL = 8;
       PE_DATADIR_TLS = 9;
       PE_DATADIR_LOADCFG = 10;
       PE_DATADIR_BOUNDIMPORT = 11;
       PE_DATADIR_IMPORTADDRESSTABLE = 12;
       PE_DATADIR_DELAYIMPORT = 13;

{$ifdef x86_64}
       IMAGE_REL_AMD64_ABSOLUTE    = $0000;  { Reference is absolute, no relocation is necessary }
       IMAGE_REL_AMD64_ADDR64      = $0001;  { 64-bit address (VA). }
       IMAGE_REL_AMD64_ADDR32      = $0002;  { 32-bit address (VA). }
       IMAGE_REL_AMD64_ADDR32NB    = $0003;  { 32-bit address w/o image base (RVA). }
       IMAGE_REL_AMD64_REL32       = $0004;  { 32-bit relative address from byte following reloc }
       IMAGE_REL_AMD64_REL32_1     = $0005;  { 32-bit relative address from byte distance 1 from reloc }
       IMAGE_REL_AMD64_REL32_2     = $0006;  { 32-bit relative address from byte distance 2 from reloc }
       IMAGE_REL_AMD64_REL32_3     = $0007;  { 32-bit relative address from byte distance 3 from reloc }
       IMAGE_REL_AMD64_REL32_4     = $0008;  { 32-bit relative address from byte distance 4 from reloc }
       IMAGE_REL_AMD64_REL32_5     = $0009;  { 32-bit relative address from byte distance 5 from reloc }
       IMAGE_REL_AMD64_SECTION     = $000A;  { Section index }
       IMAGE_REL_AMD64_SECREL      = $000B;  { 32 bit offset from base of section containing target }
       IMAGE_REL_AMD64_SECREL7     = $000C;  { 7 bit unsigned offset from base of section containing target }
       IMAGE_REL_AMD64_TOKEN       = $000D;  { 32 bit metadata token }
       IMAGE_REL_AMD64_SREL32      = $000E;  { 32 bit signed span-dependent value emitted into object }
       IMAGE_REL_AMD64_PAIR        = $000F;
       IMAGE_REL_AMD64_SSPAN32     = $0010;  { 32 bit signed span-dependent value applied at link time }
      { Direct 32 bit sign extended,
        win64 mingw GNU compiler
        also generates this type
        inside coff objects
        We assume they are equivalent to
        IMAGE_REL_AMD64_ADDR32  PM 2010-11-27 }
       R_X86_64_32S =           $11;

{$endif x86_64}

{$ifdef arm}
       IMAGE_REL_ARM_ABSOLUTE      = $0000;     { No relocation required }
       IMAGE_REL_ARM_ADDR32        = $0001;     { 32 bit address }
       IMAGE_REL_ARM_ADDR32NB      = $0002;     { 32 bit address w/o image base }
       IMAGE_REL_ARM_BRANCH24      = $0003;     { 24 bit offset << 2 & sign ext. }
       IMAGE_REL_ARM_BRANCH11      = $0004;     { Thumb: 2 11 bit offsets }
       IMAGE_REL_ARM_TOKEN         = $0005;     { clr token }
       IMAGE_REL_ARM_GPREL12       = $0006;     { GP-relative addressing (ARM) }
       IMAGE_REL_ARM_GPREL7        = $0007;     { GP-relative addressing (Thumb) }
       IMAGE_REL_ARM_BLX24         = $0008;
       IMAGE_REL_ARM_BLX11         = $0009;
       IMAGE_REL_ARM_SECTION       = $000E;     { Section table index }
       IMAGE_REL_ARM_SECREL        = $000F;     { Offset within section }
{$endif arm}

{$ifdef i386}
       IMAGE_REL_I386_DIR32 = 6;
       IMAGE_REL_I386_IMAGEBASE = 7;
       IMAGE_REL_I386_SECREL32 = 11;
       IMAGE_REL_I386_PCRLONG = 20;
{$endif i386}

       { .reloc section fixup types }
       IMAGE_REL_BASED_HIGHLOW     = 3;  { Applies the delta to the 32-bit field at Offset. }
       IMAGE_REL_BASED_DIR64       = 10; { Applies the delta to the 64-bit field at Offset. }

       { values for coffsectionrec.select }
       IMAGE_COMDAT_SELECT_NODUPLICATES = 1;
       IMAGE_COMDAT_SELECT_ANY          = 2;
       IMAGE_COMDAT_SELECT_SAME_SIZE    = 3;
       IMAGE_COMDAT_SELECT_EXACT_MATCH  = 4;
       IMAGE_COMDAT_SELECT_ASSOCIATIVE  = 5;
       IMAGE_COMDAT_SELECT_LARGEST      = 6;

    type
       coffdjoptheader=packed record
         magic  : word;
         vstamp : word;
         tsize  : longint;
         dsize  : longint;
         bsize  : longint;
         entry  : longint;
         text_start : longint;
         data_start : longint;
       end;
       coffsectionrec=packed record
         len     : longword;
         nrelocs : word;
         nlines  : word;
         checksum: longword;
         assoc   : word;
         select  : byte;
         empty   : array[0..2] of char;
       end;
       coffreloc=packed record
         address  : longword;
         sym      : longword;
         reloctype : word;
       end;
       coffsymbol=packed record
         name    : array[0..3] of char; { real is [0..7], which overlaps the strpos ! }
         strpos  : longword;
         value   : longword;
         section : smallint;
         empty   : word;                { actually type, $20: function, 0: not a function }
         typ     : byte;
         aux     : byte;
       end;

       { This is defined in rtl/win/sysos.inc source }
       tlsdirectory=packed record
         data_start, data_end : PUInt;
         index_pointer, callbacks_pointer : PUInt;
         zero_fill_size : dword;
         flags : dword;
       end;

     const
       SymbolMaxGrow = 200*sizeof(coffsymbol);
       StrsMaxGrow   = 8192;

       coffsecnames : array[TAsmSectiontype] of string[length('__DATA, __datacoal_nt,coalesced')] = ('','',
          '.text','.data','.data','.data','.bss','.tls',
          '.pdata',{pdata}
          '.text', {stub}
          '.data',
          '.data',
          '.data',
          '.data',
          '.stab','.stabstr',
          '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
          '.eh_frame',
          '.debug_frame','.debug_info','.debug_line','.debug_abbrev',
          '.fpc',
          '',
          '.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'
        );

const go32v2stub : array[0..2047] of byte=(
  $4D,$5A,$00,$00,$04,$00,$00,$00,$20,$00,$27,$00,$FF,$FF,$00,
  $00,$60,$07,$00,$00,$54,$00,$00,$00,$00,$00,$00,$00,$0D,$0A,
  $73,$74,$75,$62,$2E,$68,$20,$67,$65,$6E,$65,$72,$61,$74,$65,
  $64,$20,$66,$72,$6F,$6D,$20,$73,$74,$75,$62,$2E,$61,$73,$6D,
  $20,$62,$79,$20,$64,$6A,$61,$73,$6D,$2C,$20,$6F,$6E,$20,$54,
  $68,$75,$20,$44,$65,$63,$20,$20,$39,$20,$31,$30,$3A,$35,$39,
  $3A,$33,$31,$20,$31,$39,$39,$39,$0D,$0A,$54,$68,$65,$20,$53,
  $54,$55,$42,$2E,$45,$58,$45,$20,$73,$74,$75,$62,$20,$6C,$6F,
  $61,$64,$65,$72,$20,$69,$73,$20,$43,$6F,$70,$79,$72,$69,$67,
  $68,$74,$20,$28,$43,$29,$20,$31,$39,$39,$33,$2D,$31,$39,$39,
  $35,$20,$44,$4A,$20,$44,$65,$6C,$6F,$72,$69,$65,$2E,$20,$0D,
  $0A,$50,$65,$72,$6D,$69,$73,$73,$69,$6F,$6E,$20,$67,$72,$61,
  $6E,$74,$65,$64,$20,$74,$6F,$20,$75,$73,$65,$20,$66,$6F,$72,
  $20,$61,$6E,$79,$20,$70,$75,$72,$70,$6F,$73,$65,$20,$70,$72,
  $6F,$76,$69,$64,$65,$64,$20,$74,$68,$69,$73,$20,$63,$6F,$70,
  $79,$72,$69,$67,$68,$74,$20,$0D,$0A,$72,$65,$6D,$61,$69,$6E,
  $73,$20,$70,$72,$65,$73,$65,$6E,$74,$20,$61,$6E,$64,$20,$75,
  $6E,$6D,$6F,$64,$69,$66,$69,$65,$64,$2E,$20,$0D,$0A,$54,$68,
  $69,$73,$20,$6F,$6E,$6C,$79,$20,$61,$70,$70,$6C,$69,$65,$73,
  $20,$74,$6F,$20,$74,$68,$65,$20,$73,$74,$75,$62,$2C,$20,$61,
  $6E,$64,$20,$6E,$6F,$74,$20,$6E,$65,$63,$65,$73,$73,$61,$72,
  $69,$6C,$79,$20,$74,$68,$65,$20,$77,$68,$6F,$6C,$65,$20,$70,
  $72,$6F,$67,$72,$61,$6D,$2E,$0A,$0D,$0A,$24,$49,$64,$3A,$20,
  $73,$74,$75,$62,$2E,$61,$73,$6D,$20,$62,$75,$69,$6C,$74,$20,
  $31,$32,$2F,$30,$39,$2F,$39,$39,$20,$31,$30,$3A,$35,$39,$3A,
  $33,$31,$20,$62,$79,$20,$64,$6A,$61,$73,$6D,$20,$24,$0A,$0D,
  $0A,$40,$28,$23,$29,$20,$73,$74,$75,$62,$2E,$61,$73,$6D,$20,
  $62,$75,$69,$6C,$74,$20,$31,$32,$2F,$30,$39,$2F,$39,$39,$20,
  $31,$30,$3A,$35,$39,$3A,$33,$31,$20,$62,$79,$20,$64,$6A,$61,
  $73,$6D,$0A,$0D,$0A,$1A,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  $00,$00,$67,$6F,$33,$32,$73,$74,$75,$62,$2C,$20,$76,$20,$32,
  $2E,$30,$32,$54,$00,$00,$00,$00,$00,$08,$00,$00,$00,$00,$00,
  $00,$00,$00,$00,$00,$40,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$43,$57,$53,$44,$50,
  $4D,$49,$2E,$45,$58,$45,$00,$00,$00,$00,$00,$0E,$1F,$8C,$1E,
  $24,$00,$8C,$06,$60,$07,$FC,$B4,$30,$CD,$21,$3C,$03,$73,$08,
  $B0,$6D,$BA,$A7,$05,$E9,$D4,$03,$A2,$69,$08,$BE,$20,$00,$8B,
  $04,$09,$C0,$75,$02,$B4,$FE,$BB,$70,$08,$39,$C3,$73,$02,$89,
  $C3,$89,$1C,$FE,$C7,$B9,$04,$FF,$D3,$EB,$B4,$4A,$CD,$21,$73,
  $08,$D3,$E3,$FE,$CF,$89,$1C,$EB,$D8,$26,$8E,$06,$2C,$00,$31,
  $FF,$30,$C0,$A9,$F2,$AE,$26,$81,$3D,$50,$41,$75,$15,$AF,$26,
  $81,$3D,$54,$48,$75,$0D,$AF,$26,$80,$3D,$3D,$75,$06,$47,$89,
  $3E,$8C,$04,$4F,$AE,$75,$DF,$AF,$B4,$3E,$BB,$13,$00,$CD,$21,
  $B4,$3E,$BB,$12,$00,$CD,$21,$06,$57,$31,$C9,$74,$12,$B0,$6E,
  $BA,$7E,$05,$E9,$5E,$03,$09,$C9,$75,$F4,$41,$E8,$A1,$03,$72,
  $EE,$B8,$87,$16,$CD,$2F,$09,$C0,$75,$ED,$80,$E3,$01,$74,$E8,
  $89,$3E,$00,$06,$8C,$06,$02,$06,$89,$36,$04,$06,$5F,$07,$E8,
  $D3,$02,$89,$3E,$2A,$00,$89,$36,$62,$07,$80,$3E,$2C,$00,$00,
  $74,$23,$B9,$08,$00,$BF,$2C,$00,$8A,$05,$47,$08,$C0,$74,$05,
  $88,$07,$43,$E2,$F4,$66,$C7,$07,$2E,$45,$58,$45,$83,$C3,$04,
  $C6,$07,$00,$89,$1E,$62,$07,$B8,$00,$3D,$BA,$64,$07,$CD,$21,
  $0F,$82,$B3,$02,$A3,$06,$06,$89,$C3,$B9,$06,$00,$BA,$B5,$07,
  $B4,$3F,$CD,$21,$31,$D2,$31,$C9,$A1,$B5,$07,$3D,$4C,$01,$74,
  $1B,$3D,$4D,$5A,$0F,$85,$98,$02,$8B,$16,$B9,$07,$C1,$E2,$09,
  $8B,$1E,$B7,$07,$09,$DB,$74,$05,$80,$EE,$02,$01,$DA,$89,$16,
  $BB,$07,$89,$0E,$BD,$07,$B8,$00,$42,$8B,$1E,$06,$06,$CD,$21,
  $B9,$A8,$00,$BA,$BF,$07,$B4,$3F,$CD,$21,$3D,$A8,$00,$75,$06,
  $81,$3E,$BF,$07,$4C,$01,$0F,$85,$61,$02,$66,$A1,$E3,$07,$66,
  $A3,$10,$06,$66,$8B,$0E,$BB,$07,$66,$A1,$03,$08,$66,$01,$C8,
  $66,$A3,$08,$06,$66,$A1,$2B,$08,$66,$01,$C8,$66,$A3,$0C,$06,
  $66,$8B,$1E,$4B,$08,$66,$A1,$4F,$08,$66,$01,$C3,$66,$B8,$01,
  $00,$01,$00,$66,$39,$C3,$73,$03,$66,$89,$C3,$66,$81,$C3,$FF,
  $FF,$00,$00,$31,$DB,$66,$89,$1E,$1C,$00,$E8,$F5,$02,$8B,$1E,
  $04,$06,$09,$DB,$74,$0A,$B4,$48,$CD,$21,$0F,$82,$15,$02,$8E,
  $C0,$E8,$08,$03,$B8,$01,$00,$FF,$1E,$00,$06,$0F,$82,$0F,$02,
  $8C,$06,$26,$00,$8C,$0E,$28,$00,$8C,$D8,$A3,$22,$00,$8E,$C0,
  $31,$C0,$B9,$01,$00,$CD,$31,$72,$07,$A3,$14,$06,$31,$C0,$CD,
  $31,$0F,$82,$F3,$01,$A3,$16,$06,$66,$8B,$0E,$1C,$00,$B8,$01,
  $05,$8B,$1E,$1E,$00,$CD,$31,$0F,$82,$E5,$01,$89,$1E,$1A,$06,
  $89,$0E,$18,$06,$89,$36,$1A,$00,$89,$3E,$18,$00,$B8,$07,$00,
  $8B,$1E,$14,$06,$8B,$0E,$1A,$06,$8B,$16,$18,$06,$CD,$31,$B8,
  $09,$00,$8C,$C9,$83,$E1,$03,$C1,$E1,$05,$51,$81,$C9,$9B,$C0,
  $CD,$31,$B8,$08,$00,$8B,$0E,$1E,$00,$49,$BA,$FF,$FF,$CD,$31,
  $B8,$07,$00,$8B,$1E,$16,$06,$8B,$0E,$1A,$06,$8B,$16,$18,$06,
  $CD,$31,$B8,$09,$00,$59,$81,$C9,$93,$C0,$CD,$31,$B8,$08,$00,
  $8B,$0E,$1E,$00,$49,$BA,$FF,$FF,$CD,$31,$B8,$00,$01,$BB,$00,
  $0F,$CD,$31,$73,$10,$3D,$08,$00,$0F,$85,$73,$01,$B8,$00,$01,
  $CD,$31,$0F,$82,$6A,$01,$A3,$1C,$06,$89,$16,$1E,$06,$C1,$E3,
  $04,$89,$1E,$20,$06,$66,$8B,$36,$08,$06,$66,$8B,$3E,$FB,$07,
  $66,$8B,$0E,$FF,$07,$E8,$49,$00,$66,$8B,$36,$0C,$06,$66,$8B,
  $3E,$23,$08,$66,$8B,$0E,$27,$08,$E8,$37,$00,$8E,$06,$16,$06,
  $66,$8B,$3E,$4B,$08,$66,$8B,$0E,$4F,$08,$66,$31,$C0,$66,$C1,
  $E9,$02,$67,$F3,$66,$AB,$B4,$3E,$8B,$1E,$06,$06,$CD,$21,$B8,
  $01,$01,$8B,$16,$1E,$06,$CD,$31,$1E,$0F,$A1,$8E,$1E,$16,$06,
  $66,$64,$FF,$2E,$10,$06,$66,$89,$F0,$66,$25,$FF,$01,$00,$00,
  $66,$01,$C1,$29,$C6,$66,$29,$C7,$66,$89,$0E,$26,$06,$66,$89,
  $3E,$22,$06,$E8,$0F,$01,$89,$36,$3E,$06,$66,$C1,$EE,$10,$89,
  $36,$42,$06,$8B,$1E,$06,$06,$89,$1E,$3A,$06,$C7,$06,$46,$06,
  $00,$42,$E8,$03,$01,$A1,$1C,$06,$A3,$4E,$06,$C7,$06,$3E,$06,
  $00,$00,$C6,$06,$47,$06,$3F,$A1,$28,$06,$09,$C0,$75,$09,$A1,
  $26,$06,$3B,$06,$20,$06,$76,$03,$A1,$20,$06,$A3,$42,$06,$E8,
  $D9,$00,$66,$31,$C9,$8B,$0E,$46,$06,$66,$8B,$3E,$22,$06,$66,
  $01,$0E,$22,$06,$66,$29,$0E,$26,$06,$66,$31,$F6,$C1,$E9,$02,
  $1E,$06,$8E,$06,$16,$06,$8E,$1E,$1E,$06,$67,$F3,$66,$A5,$07,
  $1F,$66,$03,$0E,$26,$06,$75,$AF,$C3,$3C,$3A,$74,$06,$3C,$2F,
  $74,$02,$3C,$5C,$C3,$BE,$64,$07,$89,$F3,$26,$8A,$05,$47,$88,
  $04,$38,$E0,$74,$0E,$08,$C0,$74,$0A,$46,$E8,$DE,$FF,$75,$EC,
  $89,$F3,$74,$E8,$C3,$B0,$66,$BA,$48,$05,$EB,$0C,$B0,$67,$BA,
  $55,$05,$EB,$05,$B0,$68,$BA,$5F,$05,$52,$8B,$1E,$62,$07,$C6,
  $07,$24,$BB,$64,$07,$EB,$28,$E8,$F5,$00,$B0,$69,$BA,$99,$05,
  $EB,$1A,$B0,$6A,$BA,$B2,$05,$EB,$13,$B0,$6B,$BA,$C4,$05,$EB,
  $0C,$B0,$6C,$BA,$D6,$05,$EB,$05,$B0,$69,$BA,$99,$05,$52,$BB,
  $3B,$05,$E8,$15,$00,$5B,$E8,$11,$00,$BB,$67,$04,$E8,$0B,$00,
  $B4,$4C,$CD,$21,$43,$50,$B4,$02,$CD,$21,$58,$8A,$17,$80,$FA,
  $24,$75,$F2,$C3,$0D,$0A,$24,$50,$51,$57,$31,$C0,$BF,$2A,$06,
  $B9,$19,$00,$F3,$AB,$5F,$59,$58,$C3,$B8,$00,$03,$BB,$21,$00,
  $31,$C9,$66,$BF,$2A,$06,$00,$00,$CD,$31,$C3,$00,$00,$30,$E4,
  $E8,$4E,$FF,$89,$DE,$8B,$3E,$8C,$04,$EB,$17,$B4,$3B,$E8,$41,
  $FF,$81,$FE,$64,$07,$74,$12,$8A,$44,$FF,$E8,$2A,$FF,$74,$04,
  $C6,$04,$5C,$46,$E8,$03,$00,$72,$E4,$C3,$E8,$34,$00,$BB,$44,
  $00,$8A,$07,$88,$04,$43,$46,$08,$C0,$75,$F6,$06,$57,$1E,$07,
  $E8,$9B,$FF,$BB,$2A,$06,$8C,$5F,$04,$89,$5F,$02,$BA,$64,$07,
  $B8,$00,$4B,$CD,$21,$5F,$07,$72,$09,$B4,$4D,$CD,$21,$2D,$00,
  $03,$F7,$D8,$EB,$28,$80,$3E,$69,$08,$05,$72,$20,$B8,$00,$58,
  $CD,$21,$A2,$67,$08,$B8,$02,$58,$CD,$21,$A2,$68,$08,$B8,$01,
  $58,$BB,$80,$00,$CD,$21,$B8,$03,$58,$BB,$01,$00,$CD,$21,$C3,
  $9C,$80,$3E,$69,$08,$05,$72,$1A,$50,$53,$B8,$03,$58,$8A,$1E,
  $68,$08,$30,$FF,$CD,$21,$B8,$01,$58,$8A,$1E,$67,$08,$30,$FF,
  $CD,$21,$5B,$58,$9D,$C3,$4C,$6F,$61,$64,$20,$65,$72,$72,$6F,
  $72,$3A,$20,$24,$3A,$20,$63,$61,$6E,$27,$74,$20,$6F,$70,$65,
  $6E,$24,$3A,$20,$6E,$6F,$74,$20,$45,$58,$45,$24,$3A,$20,$6E,
  $6F,$74,$20,$43,$4F,$46,$46,$20,$28,$43,$68,$65,$63,$6B,$20,
  $66,$6F,$72,$20,$76,$69,$72,$75,$73,$65,$73,$29,$24,$6E,$6F,
  $20,$44,$50,$4D,$49,$20,$2D,$20,$47,$65,$74,$20,$63,$73,$64,
  $70,$6D,$69,$2A,$62,$2E,$7A,$69,$70,$24,$6E,$6F,$20,$44,$4F,
  $53,$20,$6D,$65,$6D,$6F,$72,$79,$24,$6E,$65,$65,$64,$20,$44,
  $4F,$53,$20,$33,$24,$63,$61,$6E,$27,$74,$20,$73,$77,$69,$74,
  $63,$68,$20,$6D,$6F,$64,$65,$24,$6E,$6F,$20,$44,$50,$4D,$49,
  $20,$73,$65,$6C,$65,$63,$74,$6F,$72,$73,$24,$6E,$6F,$20,$44,
  $50,$4D,$49,$20,$6D,$65,$6D,$6F,$72,$79,$24,$90,$90,$90,$90,
  $90,$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
  $90,$90,$90,$90,$90,$90,$90,$90);

const win32stub : array[0..127] of byte=(
  $4D,$5A,$90,$00,$03,$00,$00,$00,$04,$00,$00,$00,$FF,$FF,$00,$00,
  $B8,$00,$00,$00,$00,$00,$00,$00,$40,$00,$00,$00,$00,$00,$00,$00,
  $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$80,$00,$00,$00,
  $0E,$1F,$BA,$0E,$00,$B4,$09,$CD,$21,$B8,$01,$4C,$CD,$21,$54,$68,
  $69,$73,$20,$70,$72,$6F,$67,$72,$61,$6D,$20,$63,$61,$6E,$6E,$6F,
  $74,$20,$62,$65,$20,$72,$75,$6E,$20,$69,$6E,$20,$44,$4F,$53,$20,
  $6D,$6F,$64,$65,$2E,$0D,$0D,$0A,$24,$00,$00,$00,$00,$00,$00,$00);

const pemagic : array[0..3] of byte = (
  $50,$45,$00,$00);

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

    function djencodesechdrflags(aoptions:TObjSectionOptions):longword;
      begin
        if (oso_load in aoptions) then
          begin
            if oso_executable in aoptions then
              result:=COFF_STYP_TEXT
            else if not(oso_data in aoptions) then
              result:=COFF_STYP_BSS
            else
              result:=COFF_STYP_DATA;
          end
        else if oso_debug in aoptions then
          result:=COFF_STYP_INFO
        else
          result:=COFF_STYP_REG;
      end;


    function djdecodesechdrflags(const aname:string;flags:longword):TObjSectionOptions;
      begin
        result:=[];
        if flags and COFF_STYP_TEXT<>0 then
          result:=[oso_data,oso_load,oso_executable]
        else if flags and COFF_STYP_BSS<>0 then
          result:=[oso_load]
        else if flags and COFF_STYP_DATA<>0 then
          result:=[oso_data,oso_load]
        else if flags and COFF_STYP_INFO<>0 then
          result:=[oso_data,oso_debug]
        else
          result:=[oso_data]
      end;


    function peencodesechdrflags(aoptions:TObjSectionOptions;aalign:shortint):longword;
      begin
        result:=0;
        if (oso_load in aoptions) then
          begin
            if oso_executable in aoptions then
              result:=result or PE_SCN_CNT_CODE or PE_SCN_MEM_EXECUTE
            else
              begin
                if (oso_data in aoptions) then
                  result:=result or PE_SCN_CNT_INITIALIZED_DATA
                else
                  result:=result or PE_SCN_CNT_UNINITIALIZED_DATA;
              end;
            if oso_write in aoptions then
              result:=result or PE_SCN_MEM_WRITE or PE_SCN_MEM_READ
            else
              result:=result or PE_SCN_MEM_READ;
          end
        else
          result:=result or PE_SCN_MEM_DISCARDABLE;
        case aalign of
           1 : result:=result or PE_SCN_ALIGN_1BYTES;
           2 : result:=result or PE_SCN_ALIGN_2BYTES;
           4 : result:=result or PE_SCN_ALIGN_4BYTES;
           8 : result:=result or PE_SCN_ALIGN_8BYTES;
          16 : result:=result or PE_SCN_ALIGN_16BYTES;
          32 : result:=result or PE_SCN_ALIGN_32BYTES;
          64 : result:=result or PE_SCN_ALIGN_64BYTES;
          else result:=result or PE_SCN_ALIGN_16BYTES;
        end;
      end;


    procedure pedecodesechdrflags(const aname:string;flags:longword;out aoptions:TObjSectionOptions;out aalign:shortint);
      var
        alignflag : longword;
      begin
        aoptions:=[];
        if flags and PE_SCN_CNT_CODE<>0 then
          include(aoptions,oso_executable);
        if flags and PE_SCN_MEM_DISCARDABLE<>0 then
          include(aoptions,oso_debug);
        if flags and PE_SCN_CNT_UNINITIALIZED_DATA=0 then
          include(aoptions,oso_data);
        if (flags and (PE_SCN_LNK_REMOVE or PE_SCN_MEM_DISCARDABLE)=0) then
          include(aoptions,oso_load);
        { read/write }
        if flags and PE_SCN_MEM_WRITE<>0 then
          include(aoptions,oso_write);
        { alignment }
        alignflag:=flags and PE_SCN_ALIGN_MASK;
        if alignflag=PE_SCN_ALIGN_64BYTES then
          aalign:=64
        else if alignflag=PE_SCN_ALIGN_32BYTES then
          aalign:=32
        else if alignflag=PE_SCN_ALIGN_16BYTES then
          aalign:=16
        else if alignflag=PE_SCN_ALIGN_8BYTES then
          aalign:=8
        else if alignflag=PE_SCN_ALIGN_4BYTES then
          aalign:=4
        else if alignflag=PE_SCN_ALIGN_2BYTES then
          aalign:=2
        else if alignflag=PE_SCN_ALIGN_1BYTES then
          aalign:=1
        else if alignflag=0 then
          aalign:=0
        else
          Internalerror(2009050401);
      end;


{****************************************************************************
                               TCoffObjSection
****************************************************************************}

    constructor TCoffObjSection.create(AList:TFPHashObjectList;const aname:string;aalign:shortint;aoptions:TObjSectionOptions);
      begin
        inherited create(AList,aname,aalign,aoptions);
      end;


    procedure TCoffObjSection.addsymsizereloc(ofs:aword;p:TObjSymbol;symsize:aword;reloctype:TObjRelocationType);
      begin
        ObjRelocations.Add(TObjRelocation.createsymbolsize(ofs,p,symsize,reloctype));
      end;


    procedure TCoffExeOutput.DoRelocationFixup(objsec:TObjSection);
      var
        i,zero,address_size : longint;
        objreloc : TObjRelocation;
        address,
        relocval : aint;
        relocsec : TObjSection;
{$ifdef cpu64bitaddr}
        s        : string;
{$endif cpu64bitaddr}
        data     : TDynamicArray;
      begin
        data:=objsec.data;
        for i:=0 to objsec.ObjRelocations.Count-1 do
          begin
            objreloc:=TObjRelocation(objsec.ObjRelocations[i]);
            address_size:=4;
            case objreloc.typ of
              RELOC_NONE:
                continue;
              RELOC_ZERO:
                begin
                  data.Seek(objreloc.dataoffset);
                  zero:=0;
                  data.Write(zero,4);
                  continue;
                end;
{$ifdef cpu64bitaddr}
              RELOC_ABSOLUTE:
                address_size:=8;
{$endif cpu64bitaddr}
            end;

            address:=0;
            data.Seek(objreloc.dataoffset);
            data.Read(address,address_size);
            if assigned(objreloc.symbol) then
              begin
                relocsec:=objreloc.symbol.objsection;
                relocval:=objreloc.symbol.address;
              end
            else
              if assigned(objreloc.objsection) then
                begin
                  relocsec:=objreloc.objsection;
                  relocval:=objreloc.objsection.mempos
                end
            else
              internalerror(200205183);
            { Only debug sections are allowed to have relocs pointing to unused sections }
            if not relocsec.used and not (oso_debug in objsec.secoptions) then
              internalerror(200603061);

            if relocsec.used then
              case objreloc.typ of
                RELOC_RELATIVE  :
                  begin
                    address:=address-objsec.mempos+relocval;
                    if TCoffObjData(objsec.objdata).win32 then
                      dec(address,objreloc.dataoffset+4);
                  end;
                RELOC_RVA:
                  begin
                    { fixup address when the symbol was known in defined object }
                    if (relocsec.objdata=objsec.objdata) then
                      dec(address,TCoffObjSection(relocsec).orgmempos);
{$ifdef arm}
                    if (relocsec.objdata=objsec.objdata) and not TCoffObjData(objsec.objdata).eVCobj then
                      inc(address, relocsec.MemPos)
                    else
{$endif arm}
                      inc(address,relocval);
                  end;
                RELOC_SECREL32 :
                  begin
                    { fixup address when the symbol was known in defined object }
                    if (relocsec.objdata=objsec.objdata) then
                      dec(address,relocsec.ExeSection.MemPos);
                    inc(address,relocval);
                  end;
{$ifdef arm}
                RELOC_RELATIVE_24:
                  begin
                    relocval:=longint(relocval - objsec.mempos - objreloc.dataoffset) shr 2 - 2;
                    address:=address or (relocval and $ffffff);
                    relocval:=relocval shr 24;
                    if (relocval<>$3f) and (relocval<>0) then
                      internalerror(200606085);  { offset overflow }
                  end;
{$endif arm}
{$ifdef x86_64}
                { 64 bit coff only }
                RELOC_RELATIVE_1:
                  begin
                    address:=address-objsec.mempos+relocval;
                    dec(address,objreloc.dataoffset+1);
                  end;
                RELOC_RELATIVE_2:
                  begin
                    address:=address-objsec.mempos+relocval;
                    dec(address,objreloc.dataoffset+2);
                  end;
                RELOC_RELATIVE_3:
                  begin
                    address:=address-objsec.mempos+relocval;
                    dec(address,objreloc.dataoffset+3);
                  end;
                RELOC_RELATIVE_4:
                  begin
                    address:=address-objsec.mempos+relocval;
                    dec(address,objreloc.dataoffset+4);
                  end;
                RELOC_RELATIVE_5:
                  begin
                    address:=address-objsec.mempos+relocval;
                    dec(address,objreloc.dataoffset+5);
                  end;
                RELOC_ABSOLUTE32,
{$endif x86_64}
                RELOC_ABSOLUTE :
                  begin
                    if oso_common in relocsec.secoptions then
                      dec(address,objreloc.orgsize)
                    else
                      begin
                        { fixup address when the symbol was known in defined object }
                        if (relocsec.objdata=objsec.objdata) then
                          dec(address,TCoffObjSection(relocsec).orgmempos);
                      end;
{$ifdef arm}
                    if (relocsec.objdata=objsec.objdata) and not TCoffObjData(objsec.objdata).eVCobj then
                      inc(address, relocsec.MemPos)
                    else
{$endif arm}
                      inc(address,relocval);
                    inc(address,imagebase);
                  end;
                else
                  internalerror(200604014);
              end
            else
              address:=0;  { Relocation in debug section points to unused section, which is eliminated by linker }

            data.Seek(objreloc.dataoffset);
            data.Write(address,address_size);
{$ifdef cpu64bitaddr}
            if (objreloc.typ = RELOC_ABSOLUTE32) and (objsec.name <> '.stab') then
              begin
                if assigned(objreloc.symbol) then
                  s:=objreloc.symbol.Name
                else
                  s:=objreloc.objsection.Name;
                Message2(link_w_32bit_absolute_reloc, objsec.ObjData.Name, s);
              end;
{$endif cpu64bitaddr}
          end;
      end;



{****************************************************************************
                                TCoffObjData
****************************************************************************}

    constructor TCoffObjData.createcoff(const n:string;awin32:boolean;acObjSection:TObjSectionClass);
      begin
        inherited create(n);
        CObjSection:=ACObjSection;
        win32:=awin32;
        { we need at least the following 3 ObjSections }
        createsection(sec_code);
        createsection(sec_data);
        createsection(sec_bss);
        if tf_section_threadvars in target_info.flags then
          createsection(sec_threadvar);
      end;


    function TCoffObjData.sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;
      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
            secname:=coffsecnames[atype];
            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 TCoffObjData.CreateDebugSections;
      begin
        if target_dbg.id=dbg_stabs then
          begin
            stabssec:=createsection(sec_stab);
            stabstrsec:=createsection(sec_stabstr);
          end;
      end;


    procedure TCoffObjData.writereloc(data:aint;len:aword;p:TObjSymbol;reloctype:TObjRelocationType);
      var
        curraddr,
        symaddr : aword;
      begin
        if CurrObjSec=nil then
          internalerror(200403072);
        if assigned(p) then
          begin
            { current address }
            curraddr:=CurrObjSec.mempos+CurrObjSec.Size;
            { external/common symbols don't have a fixed memory position yet }
            if (p.bind=AB_COMMON) then
              begin
                { For go32v2 we need to use the size as address }
                if not win32 then
                  symaddr:=p.size
                else
                  symaddr:=0;
              end
            else
              symaddr:=p.address;
            { no symbol relocation need inside a section }
            if (p.objsection=CurrObjSec) and
               (p.bind<>AB_COMMON) then
              begin
                case reloctype of
                  RELOC_ABSOLUTE :
                    begin
                      CurrObjSec.addsectionreloc(curraddr,CurrObjSec,RELOC_ABSOLUTE);
                      inc(data,symaddr);
                    end;
{$ifdef cpu64bitaddr}
                  RELOC_ABSOLUTE32 :
                    begin
                      CurrObjSec.addsectionreloc(curraddr,CurrObjSec,RELOC_ABSOLUTE32);
                      inc(data,symaddr);
                    end;
{$endif cpu64bitaddr}
                  RELOC_RELATIVE :
                    begin
                      //inc(data,symaddr-len-CurrObjSec.Size);
                      data:=data+symaddr-len-CurrObjSec.Size;
                    end;
                  RELOC_RVA,
                  RELOC_SECREL32 :
                    begin
                      CurrObjSec.addsectionreloc(curraddr,CurrObjSec,reloctype);
                      inc(data,symaddr);
                    end;
                  else
                    internalerror(200604013);
                end;
              end
            else
              begin
                if (p.objsection<>nil) and
                   (p.bind<>AB_COMMON) then
                  CurrObjSec.addsectionreloc(curraddr,p.objsection,reloctype)
                else
                  CurrObjSec.addsymreloc(curraddr,p,reloctype);
                if (not win32) or
                   (p.objsection<>nil) then
                  inc(data,symaddr);
                if reloctype=RELOC_RELATIVE then
                  begin
                    if win32 then
                      dec(data,len-4)
                    else
                      dec(data,len+CurrObjSec.Size);
                  end;
              end;
          end
        else
          begin
            if reloctype=RELOC_RVA then
              internalerror(200603033);
          end;
        CurrObjSec.write(data,len);
      end;


{****************************************************************************
                                TDJCoffObjData
****************************************************************************}

    constructor TDJCoffObjData.create(const n:string);
      begin
        inherited createcoff(n,false,TCoffObjSection);
      end;


{****************************************************************************
                                TPECoffObjData
****************************************************************************}

    constructor TPECoffObjData.create(const n:string);
      begin
        inherited createcoff(n,true,TCoffObjSection);
      end;


{****************************************************************************
                                TCoffObjOutput
****************************************************************************}

    constructor TCoffObjOutput.createcoff(AWriter:TObjectWriter;awin32:boolean);
      begin
        inherited create(AWriter);
        win32:=awin32;
      end;


    destructor TCoffObjOutput.destroy;
      begin
        FCoffSyms.free;
        FCoffStrs.free;
        inherited destroy;
      end;


    procedure TCoffObjOutput.write_symbol(const name:string;value:aword;section:smallint;typ,aux:byte);
      var
        sym : coffsymbol;
      begin
        FillChar(sym,sizeof(sym),0);
        { symbolname }
        if length(name)>8 then
          begin
            sym.strpos:=FCoffStrs.size+4;
            FCoffStrs.writestr(name);
            FCoffStrs.writestr(#0);
          end
        else
          move(name[1],sym.name,length(name));
        sym.value:=value;
        sym.section:=section;
        sym.typ:=typ;
        sym.aux:=aux;
        inc(symidx);
        FCoffSyms.write(sym,sizeof(sym));
      end;


    procedure TCoffObjOutput.section_write_symbol(p:TObject;arg:pointer);
      var
        secrec : coffsectionrec;
      begin
        with TCoffObjSection(p) do
          begin
            Inc(plongword(arg)^);
            index:=plongword(arg)^;

            secsymidx:=symidx;
            { Both GNU and Microsoft toolchains write section symbols using
              storage class 3 (STATIC).
              No reason to use COFF_SYM_SECTION, it is silently converted to 3 by
              PE binutils and causes warnings with DJGPP binutils. }
            write_symbol(name,mempos,index,COFF_SYM_LOCAL,1);
            { AUX }
            fillchar(secrec,sizeof(secrec),0);
            secrec.len:=Size;
            secrec.nrelocs:=ObjRelocations.count;
            inc(symidx);
            FCoffSyms.write(secrec,sizeof(secrec));
          end;
      end;


    procedure TCoffObjOutput.section_write_relocs(p:TObject;arg:pointer);
      var
        i    : longint;
        rel  : coffreloc;
        objreloc : TObjRelocation;
      begin
        for i:=0 to TObjSection(p).ObjRelocations.Count-1 do
          begin
            objreloc:=TObjRelocation(TObjSection(p).ObjRelocations[i]);
            rel.address:=objreloc.dataoffset;
            if assigned(objreloc.symbol) then
              begin
                if (objreloc.symbol.bind=AB_LOCAL) then
                  rel.sym:=objreloc.symbol.objsection.secsymidx
                else
                  begin
                    if objreloc.symbol.symidx=-1 then
                      internalerror(200602233);
                    rel.sym:=objreloc.symbol.symidx;
                  end;
              end
            else
              begin
                if objreloc.objsection<>nil then
                  rel.sym:=objreloc.objsection.secsymidx
                else
                  rel.sym:=0;
              end;
            case objreloc.typ of
{$ifdef arm}
              RELOC_ABSOLUTE :
                rel.reloctype:=IMAGE_REL_ARM_ADDR32;

              { I've no idea if this is correct (FK):
              RELOC_RELATIVE :
                rel.reloctype:=IMAGE_REL_ARM_GPREL12;
              }

              RELOC_RVA :
                rel.reloctype:=IMAGE_REL_ARM_ADDR32NB;
              RELOC_SECREL32 :
                rel.reloctype:=IMAGE_REL_ARM_SECREL;
{$endif arm}
{$ifdef i386}
              RELOC_RELATIVE :
                rel.reloctype:=IMAGE_REL_I386_PCRLONG;
              RELOC_ABSOLUTE :
                rel.reloctype:=IMAGE_REL_I386_DIR32;
              RELOC_RVA :
                rel.reloctype:=IMAGE_REL_I386_IMAGEBASE;
              RELOC_SECREL32 :
                rel.reloctype:=IMAGE_REL_I386_SECREL32;
{$endif i386}
{$ifdef x86_64}
              RELOC_NONE :
                rel.reloctype:=IMAGE_REL_AMD64_ABSOLUTE;
              RELOC_RELATIVE :
                rel.reloctype:=IMAGE_REL_AMD64_REL32;
              RELOC_ABSOLUTE32 :
                rel.reloctype:=IMAGE_REL_AMD64_ADDR32;
              RELOC_ABSOLUTE :
                rel.reloctype:=IMAGE_REL_AMD64_ADDR64;
              RELOC_RVA :
                rel.reloctype:=IMAGE_REL_AMD64_ADDR32NB;
              RELOC_RELATIVE_1 :
                rel.reloctype:=IMAGE_REL_AMD64_REL32_1;
              RELOC_RELATIVE_2 :
                rel.reloctype:=IMAGE_REL_AMD64_REL32_2;
              RELOC_RELATIVE_3 :
                rel.reloctype:=IMAGE_REL_AMD64_REL32_3;
              RELOC_RELATIVE_4 :
                rel.reloctype:=IMAGE_REL_AMD64_REL32_4;
              RELOC_RELATIVE_5 :
                rel.reloctype:=IMAGE_REL_AMD64_REL32_5;
              RELOC_SECREL32 :
                rel.reloctype:=IMAGE_REL_AMD64_SECREL;
{$endif x86_64}
              else
                internalerror(200905071);
            end;
            FWriter.write(rel,sizeof(rel));
          end;
      end;


    procedure TCoffObjOutput.create_symbols(data:TObjData);
      var
        filename   : string[18];
        sectionval : word;
        globalval  : byte;
        i          : longint;
        value      : aword;
        objsym     : TObjSymbol;
        secidx     : longword;
      begin
        with TCoffObjData(data) do
         begin
           symidx:=0;
           { The `.file' record, and the file name auxiliary record }
           write_symbol('.file', 0, -2, COFF_SYM_FILE, 1);
           fillchar(filename,sizeof(filename),0);
           filename:=ExtractFileName(current_module.mainsource);
           inc(symidx);
           FCoffSyms.write(filename[1],sizeof(filename)-1);
           { Sections }
           secidx:=0;
           ObjSectionList.ForEachCall(@section_write_symbol,@secidx);
           { ObjSymbols }
           for i:=0 to ObjSymbolList.Count-1 do
             begin
               objsym:=TObjSymbol(ObjSymbolList[i]);
               if (objsym.bind=AB_LOCAL) then
                 continue;
               case objsym.bind of
                 AB_GLOBAL :
                   begin
                     globalval:=COFF_SYM_GLOBAL;
                     sectionval:=objsym.objsection.index;
                     value:=objsym.address;
                   end;
                 AB_LOCAL :
                   begin
                     globalval:=COFF_SYM_LOCAL;
                     sectionval:=objsym.objsection.index;
                     value:=objsym.address;
                   end;
                 else
                   begin
                     globalval:=COFF_SYM_GLOBAL;
                     sectionval:=0;
                     value:=objsym.size;
                   end;
               end;
               { symbolname }
               objsym.symidx:=symidx;
               write_symbol(objsym.name,value,sectionval,globalval,0);
             end;
         end;
      end;


    procedure TCoffObjOutput.section_set_reloc_datapos(p:TObject;arg:pointer);
      begin
        TCoffObjSection(p).coffrelocpos:=paint(arg)^;
        inc(paint(arg)^,sizeof(coffreloc)*TObjSection(p).ObjRelocations.count);
      end;


    procedure TCoffObjOutput.section_write_header(p:TObject;arg:pointer);
      var
        sechdr   : tcoffsechdr;
        s        : string;
        strpos   : aword;
      begin
        with TCoffObjSection(p) do
          begin
            fillchar(sechdr,sizeof(sechdr),0);
            s:=name;
            if length(s)>8 then
             begin
               strpos:=FCoffStrs.size+4;
               FCoffStrs.writestr(s);
               FCoffStrs.writestr(#0);
               s:='/'+ToStr(strpos);
             end;
            move(s[1],sechdr.name,length(s));
            if not win32 then
              begin
                sechdr.rvaofs:=mempos;
                sechdr.vsize:=mempos;
              end
            else
              begin
                if not(oso_data in secoptions) then
                  sechdr.vsize:=Size;
              end;
            sechdr.DataSize:=size;
            if (Size>0) and
               (oso_data in secoptions) then
              sechdr.datapos:=datapos;
            sechdr.nrelocs:=ObjRelocations.count;
            sechdr.relocpos:=coffrelocpos;
            if win32 then
              sechdr.flags:=peencodesechdrflags(secoptions,secalign)
            else
              sechdr.flags:=djencodesechdrflags(secoptions);
            FWriter.write(sechdr,sizeof(sechdr));
          end;
      end;


    function TCoffObjOutput.writedata(data:TObjData):boolean;
      var
        datapos,
        sympos   : aword;
        i        : longint;
        header   : tcoffheader;
      begin
        result:=false;
        FCoffSyms:=TDynamicArray.Create(SymbolMaxGrow);
        FCoffStrs:=TDynamicArray.Create(StrsMaxGrow);
        with TCoffObjData(data) do
         begin
           { Create Symbol Table }
           create_symbols(data);

           { Calculate the filepositions }
           datapos:=sizeof(tcoffheader)+sizeof(tcoffsechdr)*ObjSectionList.Count;
           { Sections first }
           layoutsections(datapos);
           { relocs }
           ObjSectionList.ForEachCall(@section_set_reloc_datapos,@datapos);
           { Symbols }
           sympos:=datapos;

           { Generate COFF header }
           fillchar(header,sizeof(tcoffheader),0);
           header.mach:=COFF_MAGIC;
           header.nsects:=ObjSectionList.Count;
           header.sympos:=sympos;
           header.syms:=symidx;
           if win32 then
             begin
{$ifndef x86_64}
               header.flag:=PE_FILE_32BIT_MACHINE or
                            PE_FILE_LINE_NUMS_STRIPPED or PE_FILE_LOCAL_SYMS_STRIPPED;
{$else x86_64}
               header.flag:=PE_FILE_LINE_NUMS_STRIPPED or PE_FILE_LOCAL_SYMS_STRIPPED;
{$endif x86_64}
             end
           else
             header.flag:=COFF_FLAG_AR32WR or COFF_FLAG_NOLINES or COFF_FLAG_NOLSYMS;
           FWriter.write(header,sizeof(header));
           { Section headers }
           ObjSectionList.ForEachCall(@section_write_header,nil);
           { ObjSections }
           WriteSectionContent(data);
           { Relocs }
           ObjSectionList.ForEachCall(@section_write_relocs,nil);
           { ObjSymbols }
           if Sympos<>FWriter.ObjSize then
             internalerror(200603051);
           FWriter.writearray(FCoffSyms);
           { Strings }
           i:=FCoffStrs.size+4;
           FWriter.write(i,4);
           FWriter.writearray(FCoffStrs);
         end;
        FCoffStrs.Free;
        FCoffStrs:=nil;
        FCoffSyms.Free;
        FCoffSyms:=nil;
      end;


    constructor TDJCoffObjOutput.create(AWriter:TObjectWriter);
      begin
        inherited createcoff(AWriter,false);
        cobjdata:=TDJCoffObjData;
      end;


    constructor TPECoffObjOutput.create(AWriter:TObjectWriter);
      begin
        inherited createcoff(AWriter,true);
        cobjdata:=TPECoffObjData;
      end;


{****************************************************************************
                                TCoffObjInput
****************************************************************************}

    constructor TCoffObjInput.createcoff(awin32:boolean);
      begin
        inherited create;
        win32:=awin32;
        FSymTbl:=nil;
      end;


    destructor TCoffObjInput.destroy;
      begin
        FCoffSyms.free;
        if assigned(FCoffStrs) then
          freemem(FCoffStrs);
        if assigned(FSymTbl) then
          freemem(FSymTbl);
        if assigned(FSecTbl) then
          freemem(FSecTbl);
        inherited destroy;
      end;


    function TCoffObjInput.GetSection(secidx:longint):TObjSection;
      begin
        result:=nil;
        if (secidx<1) or (secidx>FSecCount) then
          begin
            InputError('Failed reading coff file, invalid section index');
            exit;
          end;
        result:=FSecTbl^[secidx];
      end;


    function TCoffObjInput.Read_str(strpos:longword):string;
      begin
        if (FCoffStrs=nil) or (strpos>=FCoffStrSize) or (FCoffStrs[strpos]=#0) then
          Internalerror(200205172);
        result:=string(PChar(@FCoffStrs[strpos]));
      end;


    procedure TCoffObjInput.read_relocs(s:TCoffObjSection);
      var
        rel       : coffreloc;
        rel_type  : TObjRelocationType;
        i         : longint;
        p         : TObjSymbol;
      begin
        for i:=1 to s.coffrelocs do
         begin
           FReader.read(rel,sizeof(rel));
           case rel.reloctype of
{$ifdef arm}
             IMAGE_REL_ARM_ABSOLUTE:
               rel_type:=RELOC_NONE;
             IMAGE_REL_ARM_ADDR32:
               rel_type:=RELOC_ABSOLUTE;
             IMAGE_REL_ARM_ADDR32NB:
               rel_type:=RELOC_RVA;
             IMAGE_REL_ARM_BRANCH24:
               rel_type:=RELOC_RELATIVE_24;
             IMAGE_REL_ARM_SECREL:
               rel_type:=RELOC_SECREL32;
{$endif arm}
{$ifdef i386}
             IMAGE_REL_I386_PCRLONG :
               rel_type:=RELOC_RELATIVE;
             IMAGE_REL_I386_DIR32 :
               rel_type:=RELOC_ABSOLUTE;
             IMAGE_REL_I386_IMAGEBASE :
               rel_type:=RELOC_RVA;
             IMAGE_REL_I386_SECREL32 :
               rel_type:=RELOC_SECREL32;
{$endif i386}
{$ifdef x86_64}
             IMAGE_REL_AMD64_ABSOLUTE:
               rel_type:=RELOC_NONE;
             IMAGE_REL_AMD64_REL32:
               rel_type:=RELOC_RELATIVE;
             IMAGE_REL_AMD64_ADDR32,
             R_X86_64_32S:
               rel_type:=RELOC_ABSOLUTE32;
             IMAGE_REL_AMD64_ADDR64:
               rel_type:=RELOC_ABSOLUTE;
             IMAGE_REL_AMD64_ADDR32NB:
               rel_type:=RELOC_RVA;
             IMAGE_REL_AMD64_REL32_1:
               rel_type:=RELOC_RELATIVE_1;
             IMAGE_REL_AMD64_REL32_2:
               rel_type:=RELOC_RELATIVE_2;
             IMAGE_REL_AMD64_REL32_3:
               rel_type:=RELOC_RELATIVE_3;
             IMAGE_REL_AMD64_REL32_4:
               rel_type:=RELOC_RELATIVE_4;
             IMAGE_REL_AMD64_REL32_5:
               rel_type:=RELOC_RELATIVE_5;
             IMAGE_REL_AMD64_SECREL:
               rel_type:=RELOC_SECREL32;
{$endif x86_64}
           else
             begin
               InputError('Failed reading coff file, illegal reloctype $'+system.hexstr(rel.reloctype,4));
               exit;
             end;
           end;

           p:=FSymTbl^[rel.sym];
           if assigned(p) then
             s.addsymsizereloc(rel.address-s.mempos,p,p.size,rel_type)
           else
            begin
              InputError('Failed reading coff file, can''t resolve symbol of relocation');
              exit;
            end;
         end;
      end;


    procedure TCoffObjInput.read_symbols(objdata:TObjData);
      var
        size,
        address,
        nsyms,
        symidx    : aint;
        i         : longint;
        sym       : coffsymbol;
        objsym    : TObjSymbol;
        bind      : Tasmsymbind;
        strname   : string;
        auxrec    : array[0..17] of byte;
        objsec    : TObjSection;
      begin
        with TCoffObjData(objdata) do
         begin
           nsyms:=FCoffSyms.Size div sizeof(CoffSymbol);
           { Allocate memory for symidx -> TObjSymbol table }
           FSymTbl:=AllocMem(nsyms*sizeof(TObjSymbol));
           { Load the Symbols }
           FCoffSyms.Seek(0);
           symidx:=0;
           while (symidx<nsyms) do
            begin
              FCoffSyms.Read(sym,sizeof(sym));
              if plongint(@sym.name)^<>0 then
                begin
                  move(sym.name,strname[1],8);
                  strname[9]:=#0;
                  strname[0]:=chr(strlen(@strname[1]));
                  if strname='' then
                    Internalerror(200205171);
                end
              else
                strname:=Read_str(sym.strpos);
              bind:=AB_EXTERNAL;
              size:=0;
              address:=0;
              objsym:=nil;
              objsec:=nil;
              case sym.typ of
                COFF_SYM_GLOBAL :
                  begin
                    if sym.section=0 then
                     begin
                       if sym.value=0 then
                        bind:=AB_EXTERNAL
                       else
                        begin
                          bind:=AB_COMMON;
                          size:=sym.value;
                        end;
                     end
                    else
                     begin
                       bind:=AB_GLOBAL;
                       objsec:=GetSection(sym.section);
                       if sym.value>=objsec.mempos then
                         address:=sym.value-objsec.mempos;
                     end;
                    objsym:=CreateSymbol(strname);
                    objsym.bind:=bind;
                    objsym.typ:=AT_FUNCTION;
                    objsym.objsection:=objsec;
                    objsym.offset:=address;
                    objsym.size:=size;
                  end;
                COFF_SYM_LABEL,
                COFF_SYM_LOCAL :
                  begin
                    { do not add constants (section=-1) }
                    if sym.section<>-1 then
                     begin
                       objsec:=GetSection(sym.section);
                       if sym.value>=objsec.mempos then
                         address:=sym.value-objsec.mempos;
                       objsym:=CreateSymbol(strname);
                       objsym.bind:=AB_LOCAL;
                       objsym.typ:=AT_FUNCTION;
                       objsym.objsection:=objsec;
                       objsym.offset:=address;
                       objsym.size:=size;
                     end;
                  end;
                COFF_SYM_SECTION :
                  begin
                    if sym.section=0 then
                      InputError('Failed reading coff file, illegal section');
                    objsec:=GetSection(sym.section);
                    if assigned(objsec) then
                      begin
                        if sym.value>=objsec.mempos then
                          address:=sym.value-objsec.mempos;
                        objsym:=CreateSymbol(strname);
                        objsym.bind:=AB_LOCAL;
                        objsym.typ:=AT_FUNCTION;
                        objsym.objsection:=objsec;
                        objsym.offset:=address;
                        objsym.size:=size;
                      end;
                  end;
                COFF_SYM_FUNCTION,
                COFF_SYM_FILE :
                  ;
                else
                  internalerror(200602232);
              end;
              FSymTbl^[symidx]:=objsym;
              { read aux records }
              for i:=1 to sym.aux do
               begin
                 FCoffSyms.Read(auxrec,sizeof(auxrec));
                 inc(symidx);
               end;
              inc(symidx);
            end;
         end;
      end;


    procedure TCoffObjInput.ObjSections_read_relocs(p:TObject;arg:pointer);
      begin
        with TCoffObjSection(p) do
          begin
            { Skip debug sections }
            if (oso_debug in secoptions)  and
               (cs_link_strip in current_settings.globalswitches) and
               not(cs_link_separate_dbg_file in current_settings.globalswitches) then
              exit;

            if coffrelocs>0 then
              begin
                FReader.Seek(coffrelocpos);
                read_relocs(TCoffObjSection(p));
              end;
          end;
      end;


    function  TCoffObjInput.ReadObjData(AReader:TObjectreader;objdata:TObjData):boolean;
      var
        secalign : shortint;
        strpos,
        i        : longint;
        code     : longint;
        objsec   : TCoffObjSection;
        secoptions : TObjSectionOptions;
        header   : tcoffheader;
        sechdr   : tcoffsechdr;
        secname  : string;
        secnamebuf : array[0..15] of char;
      begin
        FReader:=AReader;
        InputFileName:=AReader.FileName;
        result:=false;
        FCoffSyms:=TDynamicArray.Create(SymbolMaxGrow);
        with TCoffObjData(objdata) do
         begin
           { Read COFF header }
           if not AReader.read(header,sizeof(tcoffheader)) then
             begin
               InputError('Can''t read COFF Header');
               exit;
             end;
           if header.mach<>COFF_MAGIC then
             begin
               InputError('Illegal COFF Magic');
               exit;
             end;
{$ifdef arm}
           eVCobj:=header.flag=$100;
{$endif arm}
           { ObjSymbols }
           AReader.Seek(header.sympos);
           if not AReader.ReadArray(FCoffSyms,header.syms*sizeof(CoffSymbol)) then
             begin
               InputError('Error reading coff symbol table');
               exit;
           end;
           { Strings }
           if not AReader.Read(FCoffStrSize,4) then
             begin
               InputError('Error reading COFF string table');
               exit;
             end;
           if (FCoffStrSize>4) then
             begin
               { allocate an extra byte and null-terminate }
               GetMem(FCoffStrs,FCoffStrSize+1);
               FCoffStrs[FCoffStrSize]:=#0;
               for i:=0 to 3 do
                 FCoffStrs[i]:=#0;
               if not AReader.Read(FCoffStrs[4],FCoffStrSize-4) then
                 begin
                   InputError('Error reading COFF string table');
                   exit;
                 end;
             end;
           { Section headers }
           { Allocate SecIdx -> TObjSection table, secidx is 1-based }
           FSecCount:=header.nsects;
           FSecTbl:=AllocMem((header.nsects+1)*sizeof(TObjSection));
           AReader.Seek(sizeof(tcoffheader)+header.opthdr);
           for i:=1 to header.nsects do
             begin
               if not AReader.read(sechdr,sizeof(sechdr)) then
                begin
                  InputError('Error reading COFF Section Headers');
                  exit;
                end;
               move(sechdr.name,secnamebuf,8);
               secnamebuf[8]:=#0;
               secname:=strpas(secnamebuf);
               if secname[1]='/' then
                 begin
                   Val(Copy(secname,2,8),strpos,code);
                   if code=0 then
                     secname:=Read_str(strpos)
                   else
                     begin
                       InputError('Error reading COFF Section Headers');
                       secname:='error';
                     end;
                 end;
               if win32 then
                 pedecodesechdrflags(secname,sechdr.flags,secoptions,secalign)
               else
                 begin
                   secoptions:=djdecodesechdrflags(secname,sechdr.flags);
                   secalign:=sizeof(pint);
                 end;
               if (Length(secname)>3) and (secname[2] in ['e','f','i','p','r']) then
                 begin
                   if (Pos('.edata',secname)=1) or
                      (Pos('.rsrc',secname)=1) or
{$ifndef x86_64}
                      (Pos('.pdata',secname)=1) or
{$endif}
                      (Pos('.fpc',secname)=1) then
                     include(secoptions,oso_keep);
                   if (Pos('.idata',secname)=1) then
                     begin
  { TODO: idata keep can maybe replaced with grouping of text and idata}
                       include(secoptions,oso_keep);
                       secname:=secname + '.' + ExtractFileName(InputFileName);
                     end;
                 end;
               objsec:=TCoffObjSection(createsection(secname,secalign,secoptions,false));
               FSecTbl^[i]:=objsec;
               if not win32 then
                 objsec.mempos:=sechdr.rvaofs;
               objsec.orgmempos:=sechdr.rvaofs;
               objsec.coffrelocs:=sechdr.nrelocs;
               objsec.coffrelocpos:=sechdr.relocpos;
               objsec.datapos:=sechdr.datapos;
               objsec.Size:=sechdr.dataSize;
             end;
           { Insert all ObjSymbols }
           read_symbols(objdata);
           { Section Data }
           ReadSectionContent(objdata);
           { Relocs }
           ObjSectionList.ForEachCall(@objsections_read_relocs,nil);
         end;
        if assigned(FCoffStrs) then
          freemem(FCoffStrs);
        FCoffStrs:=nil;
        FCoffSyms.Free;
        FCoffSyms:=nil;
        result:=true;
      end;


    constructor TDJCoffObjInput.create;
      begin
        inherited createcoff(false);
        cobjdata:=TDJCoffObjData;
      end;


    constructor TPECoffObjInput.create;
      begin
        inherited createcoff(true);
        cobjdata:=TPECoffObjData;
      end;


{****************************************************************************
                              TCoffexeoutput
****************************************************************************}

    constructor TCoffexeoutput.createcoff(awin32:boolean);
      begin
        inherited create;
        win32:=awin32;
        if target_info.system in [system_x86_64_win64] then
          MaxMemPos:=$FFFFFFFF
        else
          if target_info.system in systems_wince then
            MaxMemPos:=$1FFFFFF
          else
            MaxMemPos:=$7FFFFFFF;
      end;


    procedure TCoffexeoutput.write_symbol(const name:string;value:aword;section:smallint;typ,aux:byte);
      var
        sym : coffsymbol;
      begin
        FillChar(sym,sizeof(sym),0);
        if length(name)>8 then
          begin
             sym.strpos:=FCoffStrs.size+4;
             FCoffStrs.writestr(name);
             FCoffStrs.writestr(#0);
          end
        else
          move(name[1],sym.name,length(name));
        sym.value:=value;
        sym.section:=section;
        sym.typ:=typ;
        sym.aux:=aux;
        FWriter.write(sym,sizeof(sym));
      end;


    procedure TCoffexeoutput.globalsyms_write_symbol(p:TObject;arg:pointer);
      var
        secval,
        value  : aint;
        globalval : byte;
        exesec : TExeSection;
      begin
        if not assigned(texesymbol(p).objsymbol) then
          internalerror(200603053);
        with texesymbol(p).objsymbol do
          begin
            exesec:=TExeSection(objsection.exesection);
            { There is no exesection defined for special internal symbols
              like __image_base__ }
            if assigned(exesec) then
              begin
                secval:=exesec.secsymidx;
                if win32 then
                  value:=address-exesec.mempos
                else
                  value:=address;
              end
            else
              begin
                secval:=-1;
                value:=address;
              end;
            if bind=AB_LOCAL then
              globalval:=COFF_SYM_LOCAL
            else
              globalval:=COFF_SYM_GLOBAL;
            { reloctype address to the section in the executable }
            write_symbol(name,value,secval,globalval,0);
          end;
      end;


    procedure TCoffexeoutput.ExeSectionList_write_header(p:TObject;arg:pointer);
      var
        sechdr   : tcoffsechdr;
        s        : string;
        strpos   : aword;
      begin
        with tExeSection(p) do
          begin
            fillchar(sechdr,sizeof(sechdr),0);
            s:=name;
            if length(s)>8 then
             begin
               strpos:=FCoffStrs.size+4;
               FCoffStrs.writestr(s);
               FCoffStrs.writestr(#0);
               s:='/'+ToStr(strpos);
             end;
            move(s[1],sechdr.name,length(s));
            if win32 then
              begin
                sechdr.rvaofs:=mempos;
                sechdr.vsize:=Size;
                { sechdr.dataSize is size of initialized data, rounded up to FileAlignment
                  (so it can be greater than VirtualSize). Must be zero for sections that
                  do not contain initialized data. }
                if (oso_data in SecOptions) then
                  sechdr.datasize:=Align(Size,SectionDataAlign);
              end
            else
              begin
                if not (oso_debug in SecOptions) then
                  begin
                    sechdr.rvaofs:=mempos;
                    sechdr.vsize:=mempos;
                  end;
                sechdr.datasize:=Size;
              end;
            if (Size>0) then
              sechdr.datapos:=datapos-datapos_offset;
            sechdr.nrelocs:=0;
            sechdr.relocpos:=0;
            if win32 then
              begin
                if (target_info.system in systems_nativent) and
                   (apptype = app_native) then
                  sechdr.flags:=peencodesechdrflags(SecOptions,SecAlign) or PE_SCN_MEM_NOT_PAGED
                else
                  sechdr.flags:=peencodesechdrflags(SecOptions,SecAlign);
                { some flags are invalid in executables, reset them }
                sechdr.flags:=sechdr.flags and
                  not(PE_SCN_LNK_INFO or PE_SCN_LNK_REMOVE or
                      PE_SCN_LNK_COMDAT or PE_SCN_ALIGN_MASK);
              end
            else
              sechdr.flags:=djencodesechdrflags(SecOptions);
            FWriter.write(sechdr,sizeof(sechdr));
          end;
      end;


    procedure TCoffexeoutput.ExeSectionList_pass2_header(p:TObject;arg:pointer);
      begin
        with TExeSection(p) do
          begin
            { The debuginfo sections should already be stripped }
{            if (ExeWriteMode=ewm_exeonly) and
               (oso_debug in SecOptions) then
              internalerror(200801161); }
            inc(plongint(arg)^);
            secsymidx:=plongint(arg)^;
          end;
      end;


    function tcoffexeoutput.totalheadersize:longword;
      var
        stubsize,
        optheadersize : longword;
      begin
        if win32 then
          begin
            stubsize:=sizeof(win32stub)+sizeof(pemagic);
            optheadersize:=sizeof(tcoffpeoptheader);
          end
        else
          begin
            stubsize:=sizeof(go32v2stub);
            optheadersize:=sizeof(coffdjoptheader);
          end;
        result:=stubsize+sizeof(tcoffheader)+optheadersize;
      end;


    procedure tcoffexeoutput.MemPos_Header;
      begin
        { calculate start positions after the headers }
        currmempos:=totalheadersize+sizeof(tcoffsechdr)*longword(ExeSectionList.Count-2);
      end;


    procedure tcoffexeoutput.DataPos_Header;
      begin
        { retrieve amount of sections }
        nsects:=0;
        ExeSectionList.ForEachCall(@ExeSectionList_pass2_header,@nsects);
        { calculate start positions after the headers }
        currdatapos:=totalheadersize+longword(nsects)*sizeof(tcoffsechdr);
      end;


    procedure tcoffexeoutput.DataPos_Symbols;
      begin
        inherited DataPos_Symbols;
        { Calculating symbols position and size }
        nsyms:=ExeSymbolList.Count;
        sympos:=Align(CurrDataPos,SectionDataAlign);
        inc(CurrDataPos,sizeof(coffsymbol)*nsyms);
      end;


    function TCoffexeoutput.writedata:boolean;
      var
        i           : longword;
        header      : tcoffheader;
        djoptheader : coffdjoptheader;
        peoptheader : tcoffpeoptheader;
        textExeSec,
        dataExeSec,
        bssExeSec,
        idataExeSec,
        tlsExeSec : TExeSection;
        tlsdir : TlsDirectory;
        hassymbols,
        writeDbgStrings : boolean;

        procedure UpdateDataDir(const secname:string;idx:longint);
        var
          exesec : TExeSection;
        begin
          exesec:=FindExeSection(secname);
          if assigned(exesec) then
            begin
              peoptheader.DataDirectory[idx].vaddr:=exesec.mempos;
              peoptheader.DataDirectory[idx].size:=exesec.Size;
           end;
        end;

        procedure UpdateImports;
        var
          exesec: TExeSection;
          objsec, iat_start, iat_end, ilt_start: TObjSection;
          i: longint;
        begin
          exesec:=FindExeSection('.idata');
          if exesec=nil then
            exit;
          iat_start:=nil;
          iat_end:=nil;
          ilt_start:=nil;
          for i:=0 to exesec.ObjSectionList.Count-1 do
            begin
              objsec:=TObjSection(exesec.ObjSectionList[i]);
              if (ilt_start=nil) and (Pos('.idata$4',objsec.Name)=1) then
                ilt_start:=objsec;
              if Pos('.idata$5',objsec.Name)=1 then
                begin
                  if iat_start=nil then
                    iat_start:=objsec;
                end
              else
                if Assigned(iat_start) then
                  begin
                    iat_end:=objsec;
                    Break;
                  end;
            end;

          peoptheader.DataDirectory[PE_DATADIR_IDATA].vaddr:=exesec.mempos;
          if Assigned(ilt_start) then
            peoptheader.DataDirectory[PE_DATADIR_IDATA].size:=ilt_start.mempos-exesec.mempos
          else  { should not happen }
            peoptheader.DataDirectory[PE_DATADIR_IDATA].size:=exesec.Size;

          if Assigned(iat_start) and Assigned(iat_end) then
            begin
              peoptheader.DataDirectory[PE_DATADIR_IMPORTADDRESSTABLE].vaddr:=iat_start.mempos;
              peoptheader.DataDirectory[PE_DATADIR_IMPORTADDRESSTABLE].size:=iat_end.mempos-iat_start.mempos;
            end;
        end;

        procedure UpdateTlsDataDir;
        var
          {callbacksection : TExeSection;}
          tlsexesymbol: TExeSymbol;
          tlssymbol: TObjSymbol;
          callbackexesymbol: TExeSymbol;
          callbacksymbol: TObjSymbol;
        begin
          { according to GNU ld,
            the callback routines should be placed into .CRT$XL*
            sections, and the thread local variables in .tls
            __tls_start__ and __tls_end__ symbols
            should be used for the initialized part,
            which we do not support yet. }
          { For now, we only pass the address of the __tls_used
            asm symbol into PE_DATADIR_TLS with the correct
            size of this table (different for win32/win64 }
          tlsexesymbol:=texesymbol(ExeSymbolList.Find(
            target_info.Cprefix+'_tls_used'));
          if assigned(tlsexesymbol) then
            begin
              tlssymbol:=tlsexesymbol.ObjSymbol;
              peoptheader.DataDirectory[PE_DATADIR_TLS].vaddr:=tlssymbol.address;
              { sizeof(TlsDirectory) is different on host and target when cross-compiling }
              peoptheader.DataDirectory[PE_DATADIR_TLS].size:=TLSDIR_SIZE;
              if IsSharedLibrary then
                begin
                  { Here we should reset __FPC_tls_callbacks value to nil }
                  callbackexesymbol:=texesymbol(ExeSymbolList.Find(
                                        '__FPC_tls_callbacks'));
                  if assigned (callbackexesymbol) then
                    begin
                      callbacksymbol:=callbackexesymbol.ObjSymbol;

                    end;
                end;

           end;
        end;

      begin
        result:=false;
        FCoffStrs:=TDynamicArray.Create(StrsMaxGrow);
        textExeSec:=FindExeSection('.text');
        dataExeSec:=FindExeSection('.data');
        bssExeSec:=FindExeSection('.bss');
        tlsExeSec:=FindExeSection('.tls');
        if not assigned(TextExeSec) or
           not assigned(DataExeSec) then
          internalerror(200602231);
        { do we need to write symbols? }
        hassymbols:=(ExeWriteMode=ewm_dbgonly) or
                    (
                     (ExeWriteMode=ewm_exefull) and
                     not(cs_link_strip in current_settings.globalswitches)
                    );
        writeDbgStrings:=hassymbols or ((ExeWriteMode=ewm_exeonly) and (cs_link_separate_dbg_file in current_settings.globalswitches));
        { Stub }
        if win32 then
          begin
            FWriter.write(win32stub,sizeof(win32stub));
            FWriter.write(pemagic,sizeof(pemagic));
          end
        else
          FWriter.write(go32v2stub,sizeof(go32v2stub));
        { Initial header, will be updated later }
        fillchar(header,sizeof(header),0);
        header.mach:=COFF_MAGIC;
        header.nsects:=nsects;
        if writeDbgStrings then
          header.sympos:=sympos-datapos_offset;
        if hassymbols then
          header.syms:=nsyms;
        if win32 then
          header.opthdr:=sizeof(tcoffpeoptheader)
        else
          header.opthdr:=sizeof(coffdjoptheader);
        if win32 then
          begin
            header.flag:=PE_FILE_EXECUTABLE_IMAGE or PE_FILE_LINE_NUMS_STRIPPED;
            if target_info.system in [system_x86_64_win64] then
              header.flag:=header.flag or PE_FILE_LARGE_ADDRESS_AWARE
            else
              header.flag:=header.flag or PE_FILE_32BIT_MACHINE;
            if IsSharedLibrary then
              header.flag:=header.flag or PE_FILE_DLL;
            if FindExeSection('.reloc')=nil then
              header.flag:=header.flag or PE_FILE_RELOCS_STRIPPED;
            if (FindExeSection('.stab')=nil) and
               (FindExeSection('.debug_info')=nil) and
               (FindExeSection('.gnu_debuglink')=nil) then
              header.flag:=header.flag or PE_FILE_DEBUG_STRIPPED;
            if not hassymbols then
              header.flag:=header.flag or PE_FILE_LOCAL_SYMS_STRIPPED;
            if SetPEFlagsSetExplicity then
              header.flag:=header.flag or peflags;
          end
        else
          header.flag:=COFF_FLAG_AR32WR or COFF_FLAG_EXE or COFF_FLAG_NORELOCS or COFF_FLAG_NOLINES;
        FWriter.write(header,sizeof(header));
        { Optional COFF Header }
        if win32 then
          begin
            fillchar(peoptheader,sizeof(peoptheader),0);
            peoptheader.magic:=COFF_OPT_MAGIC;
            peoptheader.MajorLinkerVersion:=ord(version_nr)-ord('0');
            peoptheader.MinorLinkerVersion:=(ord(release_nr)-ord('0'))*10 + (ord(patch_nr)-ord('0'));
            peoptheader.tsize:=TextExeSec.Size;
            peoptheader.dsize:=DataExeSec.Size;
            if assigned(BSSExeSec) then
              peoptheader.bsize:=BSSExeSec.Size;
            peoptheader.text_start:=TextExeSec.mempos;
{$ifndef cpu64bitaddr}
            peoptheader.data_start:=DataExeSec.mempos;
{$endif cpu64bitaddr}
            peoptheader.entry:=EntrySym.Address;
            peoptheader.ImageBase:=ImageBase;
            peoptheader.SectionAlignment:=SectionMemAlign;
            peoptheader.FileAlignment:=SectionDataAlign;
            peoptheader.MajorOperatingSystemVersion:=4;
            peoptheader.MinorOperatingSystemVersion:=0;
            peoptheader.MajorImageVersion:=dllmajor;
            peoptheader.MinorImageVersion:=dllminor;
            if target_info.system in systems_wince then
              peoptheader.MajorSubsystemVersion:=3
            else
              peoptheader.MajorSubsystemVersion:=4;
            peoptheader.MinorSubsystemVersion:=0;
            peoptheader.Win32Version:=0;
            peoptheader.SizeOfImage:=Align(CurrMemPos,SectionMemAlign);
            peoptheader.SizeOfHeaders:=textExeSec.DataPos;
            peoptheader.CheckSum:=0;
            if (target_info.system in systems_nativent) and (not IsSharedLibrary or (apptype = app_native)) then
              { Although I did not really test this, it seems that Subsystem is
                not checked in DLLs except for maybe drivers}
              peoptheader.Subsystem:=PE_SUBSYSTEM_NATIVE
            else
              if target_info.system in systems_wince then
                peoptheader.Subsystem:=PE_SUBSYSTEM_WINDOWS_CE_GUI
              else
                if apptype=app_gui then
                  peoptheader.Subsystem:=PE_SUBSYSTEM_WINDOWS_GUI
                else
                  peoptheader.Subsystem:=PE_SUBSYSTEM_WINDOWS_CUI;
            peoptheader.DllCharacteristics:=0;
            peoptheader.SizeOfStackReserve:=stacksize;
            peoptheader.SizeOfStackCommit:=$1000;
            if MinStackSizeSetExplicity then
              peoptheader.SizeOfStackCommit:=minstacksize;
            if MaxStackSizeSetExplicity then
              peoptheader.SizeOfStackReserve:=maxstacksize;
            peoptheader.SizeOfHeapReserve:=$100000;
            peoptheader.SizeOfHeapCommit:=$1000;
            peoptheader.NumberOfRvaAndSizes:=PE_DATADIR_ENTRIES;
            UpdateImports;
            UpdateTlsDataDir;
            UpdateDataDir('.edata',PE_DATADIR_EDATA);
            UpdateDataDir('.rsrc',PE_DATADIR_RSRC);
            UpdateDataDir('.pdata',PE_DATADIR_PDATA);
            UpdateDataDir('.reloc',PE_DATADIR_RELOC);
            FWriter.write(peoptheader,sizeof(peoptheader));
          end
        else
          begin
            fillchar(djoptheader,sizeof(djoptheader),0);
            djoptheader.magic:=COFF_OPT_MAGIC;
            djoptheader.tsize:=TextExeSec.Size;
            djoptheader.dsize:=DataExeSec.Size;
            if assigned(BSSExeSec) then
              djoptheader.bsize:=BSSExeSec.Size;
            djoptheader.text_start:=TextExeSec.mempos;
            djoptheader.data_start:=DataExeSec.mempos;
            djoptheader.entry:=EntrySym.Address;
            FWriter.write(djoptheader,sizeof(djoptheader));
          end;

        { For some unknown reason WM 6.1 requires .idata section to be read only.
          Otherwise it refuses to load DLLs greater than 64KB.
          Earlier versions of WinCE load DLLs regardless of .idata flags. }
        if target_info.system in systems_wince then
          begin
            idataExeSec:=FindExeSection('.idata');
            if idataExeSec<>nil then
              idataExeSec.SecOptions:=idataExeSec.SecOptions - [oso_write];
          end;

        { Section headers }
        ExeSectionList.ForEachCall(@ExeSectionList_write_header,nil);
        { Section data }
        WriteExeSectionContent;
        { Align after the last section }
        FWriter.Writezeros(Align(FWriter.Size,SectionDataAlign)-FWriter.Size);

        { Optional Symbols }
        if SymPos<>FWriter.Size then
          internalerror(200602252);
        if hassymbols then
          ExeSymbolList.ForEachCall(@globalsyms_write_symbol,nil);
        if writeDbgStrings then
          begin
            { Strings }
            i:=FCoffStrs.size+4;
            FWriter.write(i,4);
            FWriter.writearray(FCoffStrs);
          end;
        { Release }
        FCoffStrs.Free;
        result:=true;
      end;


    function IdataObjSectionCompare(Item1, Item2: Pointer): Integer;
      var
        I1 : TObjSection absolute Item1;
        I2 : TObjSection absolute Item2;
      begin
        Result:=CompareStr(I1.Name,I2.Name);
      end;

    procedure TCoffexeoutput.Order_ObjSectionList(ObjSectionList: TFPObjectList;const aPattern:string);
      begin
        { Sort sections having '$' in the name, that's how PECOFF documentation
          tells to handle them. However, look for '$' in the pattern, not in section
          names, because the latter often get superfluous '$' due to mangling. }
        if Pos('$',aPattern)>0 then
          ObjSectionList.Sort(@IdataObjSectionCompare);
      end;


    constructor TDJCoffexeoutput.create;
      begin
        inherited createcoff(false);
        datapos_offset:=sizeof(go32v2stub);
        CExeSection:=TExeSection;
        CObjData:=TDJCoffObjData;
      end;


    procedure TDJCoffexeoutput.MemPos_Header;
      begin
        { Headers are not loaded, first 4K page is reserved }
        CurrMemPos:=$1000;
      end;

    constructor TPECoffexeoutput.create;
      begin
        inherited createcoff(true);
        CExeSection:=TExeSection;
        CObjData:=TPECoffObjData;
      end;


    procedure TPECoffexeoutput.GenerateLibraryImports(ImportLibraryList:TFPHashObjectList);
      var
        textobjsection,
        idata2objsection,
        idata4objsection,
        idata5objsection,
        idata6objsection,
        idata7objsection : TObjSection;
        idata2label : TObjSymbol;
        basedllname : string;

        procedure StartImport(const dllname:string);
        var
          idata4label,
          idata5label,
          idata7label : TObjSymbol;
          emptyint    : longint;
        begin
          if assigned(exemap) then
            begin
              exemap.Add('');
              exemap.Add('Importing from DLL '+dllname);
            end;
          emptyint:=0;
          basedllname:=ExtractFileName(dllname);
          idata2objsection:=internalobjdata.createsection(sec_idata2,basedllname);
          idata2label:=internalobjdata.SymbolDefine('__imp_dir_'+basedllname,AB_LOCAL,AT_DATA);
          idata4objsection:=internalobjdata.createsection(sec_idata4,basedllname);
          idata4label:=internalobjdata.SymbolDefine('__imp_names_'+basedllname,AB_LOCAL,AT_DATA);
          idata5objsection:=internalobjdata.createsection(sec_idata5,basedllname);
          idata5label:=internalobjdata.SymbolDefine('__imp_fixup_'+basedllname,AB_LOCAL,AT_DATA);
          idata7objsection:=internalobjdata.createsection(sec_idata7,basedllname);
          idata7label:=internalobjdata.SymbolDefine('__imp_dll_'+basedllname,AB_LOCAL,AT_DATA);
          { idata2 }
          internalobjdata.SetSection(idata2objsection);
          { dummy links to imports finalization }
          internalobjdata.writereloc(0,0,internalobjdata.SymbolRef('__imp_names_end_'+basedllname),RELOC_NONE);
          internalobjdata.writereloc(0,0,internalobjdata.SymbolRef('__imp_fixup_end_'+basedllname),RELOC_NONE);
          { section data }
          internalobjdata.writereloc(0,sizeof(longint),idata4label,RELOC_RVA);
          internalobjdata.writebytes(emptyint,sizeof(emptyint));
          internalobjdata.writebytes(emptyint,sizeof(emptyint));
          internalobjdata.writereloc(0,sizeof(longint),idata7label,RELOC_RVA);
          internalobjdata.writereloc(0,sizeof(longint),idata5label,RELOC_RVA);
          { idata7 }
          internalobjdata.SetSection(idata7objsection);
          internalobjdata.writebytes(basedllname[1],length(basedllname));
          internalobjdata.writebytes(emptyint,1);
        end;

        procedure EndImport;
        var
          emptyint : longint;
        begin
          emptyint:=0;
          { These are referenced from idata2, oso_keep is not necessary. }
          idata4objsection:=internalobjdata.createsection(sec_idata4, basedllname+'_z_');
          internalobjdata.SymbolDefine('__imp_names_end_'+basedllname,AB_LOCAL,AT_DATA);
          idata5objsection:=internalobjdata.createsection(sec_idata5, basedllname+'_z_');
          internalobjdata.SymbolDefine('__imp_fixup_end_'+basedllname,AB_LOCAL,AT_DATA);
          { idata4 }
          internalobjdata.SetSection(idata4objsection);
          internalobjdata.writebytes(emptyint,sizeof(emptyint));
          if target_info.system=system_x86_64_win64 then
            internalobjdata.writebytes(emptyint,sizeof(emptyint));
          { idata5 }
          internalobjdata.SetSection(idata5objsection);
          internalobjdata.writebytes(emptyint,sizeof(emptyint));
          if target_info.system=system_x86_64_win64 then
            internalobjdata.writebytes(emptyint,sizeof(emptyint));
        end;

        function AddImport(const afuncname,amangledname:string; AOrdNr:longint;isvar:boolean):TObjSymbol;
        const
{$ifdef x86_64}
          jmpopcode : array[0..1] of byte = (
            $ff,$25             // jmp qword [rip + offset32]
          );
{$else x86_64}
  {$ifdef arm}
          jmpopcode : array[0..7] of byte = (
            $00,$c0,$9f,$e5,    // ldr ip, [pc, #0]
            $00,$f0,$9c,$e5     // ldr pc, [ip]
          );
  {$else arm}
          jmpopcode : array[0..1] of byte = (
            $ff,$25
          );
  {$endif arm}
{$endif x86_64}
          nopopcodes : array[0..1] of byte = (
            $90,$90
          );
        var
          idata4label,
          idata5label,
          idata6label : TObjSymbol;
          emptyint : longint;
          secname,
          num : string;
          absordnr: word;

          procedure WriteTableEntry;
          var
            ordint: dword;
          begin
            if AOrdNr <= 0 then
              begin
                { import by name }
                internalobjdata.writereloc(0,sizeof(longint),idata6label,RELOC_RVA);
                if target_info.system=system_x86_64_win64 then
                  internalobjdata.writebytes(emptyint,sizeof(emptyint));
              end
            else
              begin
                { import by ordinal }
                ordint:=AOrdNr;
                if target_info.system=system_x86_64_win64 then
                  begin
                    internalobjdata.writebytes(ordint,sizeof(ordint));
                    ordint:=$80000000;
                    internalobjdata.writebytes(ordint,sizeof(ordint));
                  end
                else
                  begin
                    ordint:=ordint or $80000000;
                    internalobjdata.writebytes(ordint,sizeof(ordint));
                  end;
              end;
          end;

        begin
          result:=nil;
          emptyint:=0;
          if assigned(exemap) then
            begin
              if AOrdNr <= 0 then
                exemap.Add(' Importing Function '+afuncname)
              else
                exemap.Add(' Importing Function '+afuncname+' (OrdNr='+tostr(AOrdNr)+')');
            end;

          with internalobjdata do
            begin
              secname:=basedllname+'_i_'+amangledname;
              textobjsection:=createsection(sectionname(sec_code,secname,secorder_default),current_settings.alignment.procalign,sectiontype2options(sec_code) - [oso_keep]);
              idata4objsection:=createsection(sec_idata4, secname);
              idata5objsection:=createsection(sec_idata5, secname);
              idata6objsection:=createsection(sec_idata6, secname);
            end;

          { idata6, import data (ordnr+name) }
          internalobjdata.SetSection(idata6objsection);
          inc(idatalabnr);
          num:=tostr(idatalabnr);
          idata6label:=internalobjdata.SymbolDefine('__imp_'+num,AB_LOCAL,AT_DATA);
          absordnr:=Abs(AOrdNr);
          { write index hint }
          internalobjdata.writebytes(absordnr,2);
          if AOrdNr <= 0 then
            internalobjdata.writebytes(afuncname[1],length(afuncname));
          internalobjdata.writebytes(emptyint,1);
          internalobjdata.writebytes(emptyint,align(internalobjdata.CurrObjSec.size,2)-internalobjdata.CurrObjSec.size);
          { idata4, import lookup table }
          internalobjdata.SetSection(idata4objsection);
          idata4label:=internalobjdata.SymbolDefine('__imp_lookup_'+num,AB_LOCAL,AT_DATA);
          WriteTableEntry;
          { idata5, import address table }
          internalobjdata.SetSection(idata5objsection);
          { dummy back links }
          internalobjdata.writereloc(0,0,idata4label,RELOC_NONE);
          internalobjdata.writereloc(0,0,idata2label,RELOC_NONE);
          { section data }
          if isvar then
            result:=internalobjdata.SymbolDefine(amangledname,AB_GLOBAL,AT_DATA)
          else
            idata5label:=internalobjdata.SymbolDefine('__imp_'+amangledname,AB_LOCAL,AT_DATA);
          WriteTableEntry;
          { text, jmp }
          if not isvar then
            begin
              internalobjdata.SetSection(textobjsection);
              result:=internalobjdata.SymbolDefine('_'+amangledname,AB_GLOBAL,AT_FUNCTION);
              internalobjdata.writebytes(jmpopcode,sizeof(jmpopcode));
{$ifdef x86_64}
              internalobjdata.writereloc(0,4,idata5label,RELOC_RELATIVE);
{$else}
              internalobjdata.writereloc(0,4,idata5label,RELOC_ABSOLUTE32);
{$endif x86_64}

              internalobjdata.writebytes(nopopcodes,align(internalobjdata.CurrObjSec.size,sizeof(nopopcodes))-internalobjdata.CurrObjSec.size);
            end;
        end;

      var
        i,j : longint;
        ImportLibrary : TImportLibrary;
        ImportSymbol  : TImportSymbol;
        exesym     : TExeSymbol;
      begin
        for i:=0 to ImportLibraryList.Count-1 do
          begin
            ImportLibrary:=TImportLibrary(ImportLibraryList[i]);
            idata2objsection:=nil;
            idata4objsection:=nil;
            idata5objsection:=nil;
            idata6objsection:=nil;
            idata7objsection:=nil;
            for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do
              begin
                ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
                exesym:=TExeSymbol(ExeSymbolList.Find(ImportSymbol.MangledName));
                if assigned(exesym) and
                   (exesym.State<>symstate_defined) then
                  begin
                    if not assigned(idata2objsection) then
                      StartImport(ImportLibrary.Name);
                    exesym.objsymbol:=AddImport(ImportSymbol.Name,ImportSymbol.MangledName,ImportSymbol.OrdNr,ImportSymbol.IsVar);
                    exesym.State:=symstate_defined;
                  end;
              end;
            if assigned(idata2objsection) then
              EndImport;
          end;
        PackUnresolvedExeSymbols('after DLL imports');
      end;


    procedure TPECoffexeoutput.GenerateRelocs;
      var
        pgaddr, hdrpos : longword;

      procedure FinishBlock;
      var
        p,len : longint;
      begin
        if hdrpos = longword(-1) then
          exit;
        p:=0;
        internalobjdata.writebytes(p,align(internalobjdata.CurrObjSec.size,4)-internalobjdata.CurrObjSec.size);
        p:=internalObjData.CurrObjSec.Data.Pos;
        internalObjData.CurrObjSec.Data.seek(hdrpos+4);
        len:=p-hdrpos;
        internalObjData.CurrObjSec.Data.write(len,4);
        internalObjData.CurrObjSec.Data.seek(p);
        hdrpos:=longword(-1);
      end;

      var
        exesec : TExeSection;
        objsec : TObjSection;
        objreloc : TObjRelocation;
        i,j,k : longint;
        offset : longword;
        w: word;
      begin
        if not RelocSection or FRelocsGenerated then
          exit;
        exesec:=FindExeSection('.reloc');
        if exesec=nil then
          exit;
        objsec:=internalObjData.createsection('.reloc',0,exesec.SecOptions+[oso_data]);
        exesec.AddObjSection(objsec);
        pgaddr:=longword(-1);
        hdrpos:=longword(-1);
        for i:=0 to ExeSectionList.Count-1 do
          begin
            exesec:=TExeSection(ExeSectionList[i]);
            for j:=0 to exesec.ObjSectionList.count-1 do
              begin
                objsec:=TObjSection(exesec.ObjSectionList[j]);
                { create relocs only for sections which are loaded in memory }
                if not (oso_load in objsec.SecOptions) then
                  continue;
                for k:=0 to objsec.ObjRelocations.Count-1 do
                  begin
                    objreloc:=TObjRelocation(objsec.ObjRelocations[k]);
                    if not (objreloc.typ in [{$ifdef cpu64bitaddr}RELOC_ABSOLUTE32,{$endif cpu64bitaddr}RELOC_ABSOLUTE]) then
                      continue;
                    offset:=objsec.MemPos+objreloc.dataoffset;
                    if (offset<pgaddr) and (pgaddr<>longword(-1)) then
                      Internalerror(2007062701);
                    if (offset-pgaddr>=4096) or (pgaddr=longword(-1)) then
                      begin
                        FinishBlock;
                        pgaddr:=(offset div 4096)*4096;
                        hdrpos:=internalObjData.CurrObjSec.Data.Pos;
                        internalObjData.writebytes(pgaddr,4);
                        { Reserving space for block size. The size will be written later in FinishBlock }
                        internalObjData.writebytes(k,4);
                      end;
{$ifdef cpu64bitaddr}
                    if objreloc.typ = RELOC_ABSOLUTE then
                      w:=IMAGE_REL_BASED_DIR64
                    else
{$endif cpu64bitaddr}
                      w:=IMAGE_REL_BASED_HIGHLOW;
                    w:=(w shl 12) or (offset-pgaddr);
                    internalObjData.writebytes(w,2);
                  end;
              end;
          end;
        FinishBlock;
        FRelocsGenerated:=true;
      end;


    procedure TPECoffexeoutput.Order_End;
      var
        exesec : TExeSection;
      begin
        inherited;
        if not IsSharedLibrary then
          exit;
        exesec:=FindExeSection('.reloc');
        if exesec=nil then
          exit;
        exesec.SecOptions:=exesec.SecOptions + [oso_Data,oso_keep,oso_load];
      end;


      procedure TPECoffexeoutput.MemPos_ExeSection(const aname:string);
        begin
          if aname='.reloc' then
            GenerateRelocs;
          inherited;
        end;



{****************************************************************************
                                 TDJCoffAssembler
****************************************************************************}

    constructor TDJCoffAssembler.Create(smart:boolean);
      begin
        inherited Create(smart);
        CObjOutput:=TDJCoffObjOutput;
      end;


{****************************************************************************
                               TPECoffAssembler
****************************************************************************}

    constructor TPECoffAssembler.Create(smart:boolean);
      begin
        inherited Create(smart);
        CObjOutput:=TPECoffObjOutput;
      end;


{*****************************************************************************
                                   DLLReader
*****************************************************************************}

{$ifdef win32}
    var
      Wow64DisableWow64FsRedirection : function (var OldValue : pointer) : boolean;stdcall;
      Wow64RevertWow64FsRedirection : function (OldValue : pointer) : boolean;stdcall;
{$endif win32}

    function ReadDLLImports(const dllname:string;readdllproc:Treaddllproc):boolean;
      type
       TPECoffExpDir=packed record
         flag,
         stamp      : cardinal;
         Major,
         Minor      : word;
         Name,
         Base,
         NumFuncs,
         NumNames,
         AddrFuncs,
         AddrNames,
         AddrOrds   : cardinal;
       end;
      var
        DLLReader : TObjectReader;
        DosHeader : array[0..$7f] of byte;
        PEMagic   : array[0..3] of byte;
        Header    : TCoffHeader;
        peheader  : tcoffpeoptheader;
        NameOfs,
        newheaderofs : longword;
        FuncName  : string;
        expdir    : TPECoffExpDir;
        i         : longint;
        found     : boolean;
        sechdr    : tCoffSecHdr;
{$ifdef win32}
        p : pointer;
{$endif win32}
      begin
        result:=false;
{$ifdef win32}
        if (target_info.system=system_x86_64_win64) and
          assigned(Wow64DisableWow64FsRedirection) then
          Wow64DisableWow64FsRedirection(p);
{$endif win32}
        DLLReader:=TObjectReader.Create;
        DLLReader.OpenFile(dllname);
{$ifdef win32}
        if (target_info.system=system_x86_64_win64) and
          assigned(Wow64RevertWow64FsRedirection) then
          Wow64RevertWow64FsRedirection(p);
{$endif win32}
        if not DLLReader.Read(DosHeader,sizeof(DosHeader)) or
           (DosHeader[0]<>$4d) or (DosHeader[1]<>$5a) then
          begin
            Comment(V_Error,'Invalid DLL '+dllname+', Dos Header invalid');
            exit;
          end;
        newheaderofs:=cardinal(DosHeader[$3c]) or (DosHeader[$3d] shl 8) or (DosHeader[$3e] shl 16) or (DosHeader[$3f] shl 24);
        DLLReader.Seek(newheaderofs);
        if not DLLReader.Read(PEMagic,sizeof(PEMagic)) or
           (PEMagic[0]<>$50) or (PEMagic[1]<>$45) or (PEMagic[2]<>$00) or (PEMagic[3]<>$00) then
          begin
            Comment(V_Error,'Invalid DLL '+dllname+': invalid magic code');
            exit;
          end;
        if not DLLReader.Read(Header,sizeof(TCoffHeader)) or
           (Header.mach<>COFF_MAGIC) or
           (Header.opthdr<>sizeof(tcoffpeoptheader)) then
          begin
            Comment(V_Error,'Invalid DLL '+dllname+', invalid header size');
            exit;
          end;
        { Read optheader }
        DLLreader.Read(peheader,sizeof(tcoffpeoptheader));
        { Section headers }
        found:=false;
        for i:=1 to header.nsects do
          begin
            if not DLLreader.read(sechdr,sizeof(sechdr)) then
              begin
                Comment(V_Error,'Error reading coff file '+DLLName);
                exit;
              end;
            if (sechdr.rvaofs<=peheader.DataDirectory[PE_DATADIR_EDATA].vaddr) and
               (peheader.DataDirectory[PE_DATADIR_EDATA].vaddr<sechdr.rvaofs+sechdr.vsize) then
              begin
                found:=true;
                break;
              end;
          end;
        if not found then
          begin
            Comment(V_Warning,'DLL '+DLLName+' does not contain any exports');
            exit;
          end;
        { Process edata }
        DLLReader.Seek(sechdr.datapos+peheader.DataDirectory[PE_DATADIR_EDATA].vaddr-sechdr.rvaofs);
        DLLReader.Read(expdir,sizeof(expdir));
        for i:=0 to expdir.NumNames-1 do
          begin
            DLLReader.Seek(sechdr.datapos+expdir.AddrNames-sechdr.rvaofs+i*4);
            DLLReader.Read(NameOfs,4);
            Dec(NameOfs,sechdr.rvaofs);
            if {(NameOfs<0) or}
               (NameOfs>sechdr.vsize) then
              begin
                Comment(V_Error,'DLL does contains invalid exports');
                break;
              end;
            { Read Function name from DLL, prepend _ and terminate with #0 }
            DLLReader.Seek(sechdr.datapos+NameOfs);
            DLLReader.Read((@FuncName[1])^,sizeof(FuncName)-3);
            FuncName[sizeof(FuncName)-1]:=#0;
            FuncName[0]:=chr(Strlen(@FuncName[1]));
            readdllproc(DLLName,FuncName);
          end;
        DLLReader.Free;
      end;


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

{$ifdef i386}
    const
       as_i386_coff_info : tasminfo =
          (
            id     : as_i386_coff;
            idtxt  : 'COFF';
            asmbin : '';
            asmcmd : '';
            supported_targets : [system_i386_go32v2];
            flags : [af_outputbinary,af_smartlink_sections];
            labelprefix : '.L';
            comment : '';
            dollarsign: '$';
          );

       as_i386_pecoff_info : tasminfo =
          (
            id     : as_i386_pecoff;
            idtxt  : 'PECOFF';
            asmbin : '';
            asmcmd : '';
            supported_targets : [system_i386_win32,system_i386_nativent];
            flags : [af_outputbinary,af_smartlink_sections];
            labelprefix : '.L';
            comment : '';
            dollarsign: '$';
          );

       as_i386_pecoffwdosx_info : tasminfo =
          (
            id     : as_i386_pecoffwdosx;
            idtxt  : 'PEWDOSX';
            asmbin : '';
            asmcmd : '';
            supported_targets : [system_i386_wdosx];
            flags : [af_outputbinary];
            labelprefix : '.L';
            comment : '';
            dollarsign: '$';
          );

       as_i386_pecoffwince_info : tasminfo =
          (
            id     : as_i386_pecoffwince;
            idtxt  : 'PECOFFWINCE';
            asmbin : '';
            asmcmd : '';
            supported_targets : [system_i386_wince];
            flags : [af_outputbinary,af_smartlink_sections];
            labelprefix : '.L';
            comment : '';
            dollarsign: '$';
          );
{$endif i386}
{$ifdef x86_64}
    const
       as_x86_64_pecoff_info : tasminfo =
          (
            id     : as_x86_64_pecoff;
            idtxt  : 'PECOFF';
            asmbin : '';
            asmcmd : '';
            supported_targets : [system_x86_64_win64];
            flags : [af_outputbinary,af_smartlink_sections];
            labelprefix : '.L';
            comment : '';
            dollarsign: '$';
          );
{$endif x86_64}
{$ifdef arm}
    const
       as_arm_pecoffwince_info : tasminfo =
          (
            id     : as_arm_pecoffwince;
            idtxt  : 'PECOFFWINCE';
            asmbin : '';
            asmcmd : '';
            supported_targets : [system_arm_wince];
            flags : [af_outputbinary];
            labelprefix : '.L';
            comment : '';
            dollarsign: '$';
          );
{$endif arm}


{$ifdef win32}
  procedure SetupProcVars;
    var
      hinstLib : THandle;
    begin
      Wow64DisableWow64FsRedirection:=nil;
      Wow64RevertWow64FsRedirection:=nil;
      hinstLib:=LoadLibrary('kernel32.dll');
      if hinstLib<>0 then
        begin
          pointer(Wow64DisableWow64FsRedirection):=GetProcAddress(hinstLib,'Wow64DisableWow64FsRedirection');
          pointer(Wow64RevertWow64FsRedirection):=GetProcAddress(hinstLib,'Wow64RevertWow64FsRedirection');
          FreeLibrary(hinstLib);
        end;
    end;
{$endif win32}


initialization
{$ifdef i386}
  RegisterAssembler(as_i386_coff_info,TDJCoffAssembler);
  RegisterAssembler(as_i386_pecoff_info,TPECoffAssembler);
  RegisterAssembler(as_i386_pecoffwdosx_info,TPECoffAssembler);
  RegisterAssembler(as_i386_pecoffwince_info,TPECoffAssembler);
{$endif i386}
{$ifdef x86_64}
  RegisterAssembler(as_x86_64_pecoff_info,TPECoffAssembler);
{$endif x86_64}
{$ifdef arm}
  RegisterAssembler(as_arm_pecoffwince_info,TPECoffAssembler);
{$endif arm}
{$ifdef win32}
  SetupProcVars;
{$endif win32}
end.