freepascal.compiler/compiler/systems/t_win.pas

{
    Copyright (c) 1998-2002 by Peter Vreman

    This unit implements support import,export,link routines
    for the (i386) Win32 target

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

{$i fpcdefs.inc}

interface
    uses
       dos,
       cutils,cclasses,
       aasmbase,aasmtai,aasmdata,aasmcpu,fmodule,globtype,globals,systems,verbose,
       symconst,symdef,symsym,
       script,gendef,
       cpubase,
       import,export,link,cgobj,i_win;


    const
       MAX_DEFAULT_EXTENSIONS = 3;

    type
       tStr4=array[1..MAX_DEFAULT_EXTENSIONS] of string[4];
       pStr4=^tStr4;

      twin32imported_item = class(timported_item)
      end;

      TImportLibWin=class(timportlib)
      private
        procedure win32importproc(const module : string;index : longint;const name : string);
        procedure importvariable_str(const s:string;const name,module:string);
        procedure importprocedure_str(const module:string;index:longint;const name:string);
        procedure generateimportlib;
        procedure generateidatasection;
      public
        procedure preparelib(const s:string);override;
        procedure importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);override;
        procedure importvariable(vs:tglobalvarsym;const name,module:string);override;
        procedure generatelib;override;
      end;

      TExportLibWin=class(texportlib)
        st : string;
        EList_indexed:TFPList;
        EList_nonindexed:TFPList;
        procedure preparelib(const s:string);override;
        procedure exportprocedure(hp : texported_item);override;
        procedure exportvar(hp : texported_item);override;
        procedure exportfromlist(hp : texported_item);
        procedure generatelib;override;
        procedure generatenasmlib;virtual;
      end;

      TInternalLinkerWin = class(tinternallinker)
        constructor create;override;
        procedure DefaultLinkScript;override;
      end;

      TExternalLinkerWin=class(texternallinker)
      private
         Function  WriteResponseFile(isdll:boolean) : Boolean;
         Function  PostProcessExecutable(const fn:string;isdll:boolean) : Boolean;
      public
         Constructor Create;override;
         Procedure SetDefaultInfo;override;
         function  MakeExecutable:boolean;override;
         function  MakeSharedLibrary:boolean;override;
      end;

      TDLLScannerWin=class(tDLLScanner)
      private
        importfound : boolean;
        procedure CheckDLLFunc(const dllname,funcname:string);
      public
        function Scan(const binname:string):boolean;override;
      end;


implementation

  uses
    cpuinfo,cgutils,dbgbase,
    owar,ogbase,ogcoff;


  const
    res_gnu_windres_info : tresinfo =
        (
          id     : res_gnu_windres;
          resbin : 'windres';
          rescmd : '--include $INC -O coff -o $OBJ $RES'
        );

    res_gnu_wince_windres_info : tresinfo =
        (
          id     : res_gnu_wince_windres;
          resbin : 'windres';
          rescmd : '--include $INC -O coff -o $OBJ $RES'
        );

{*****************************************************************************
                             TImportLibWin
*****************************************************************************}

    procedure TImportLibWin.preparelib(const s : string);
      begin
         if current_asmdata.asmlists[al_imports]=nil then
           current_asmdata.asmlists[al_imports]:=TAsmList.create;
      end;


    procedure TImportLibWin.win32importproc(const module : string;index : longint;const name : string);
      var
         hp1 : timportList;
         hp2 : twin32imported_item;
         hs  : string;
      begin
         { append extension if required }
         hs:=AddExtension(module,target_info.sharedlibext);
         { search for the module }
         hp1:=timportlist(current_module.imports.first);
         while assigned(hp1) do
           begin
              if hs=hp1.dllname^ then
                break;
              hp1:=timportlist(hp1.next);
           end;
         { generate a new item ? }
         if not(assigned(hp1)) then
           begin
              hp1:=timportlist.create(hs);
              current_module.imports.concat(hp1);
           end;
         { search for reuse of old import item }
         hp2:=twin32imported_item(hp1.imported_items.first);
         while assigned(hp2) do
          begin
            if (hp2.name^=name) and (hp2.ordnr=index) then
              break;
            hp2:=twin32imported_item(hp2.next);
          end;
         if not assigned(hp2) then
          begin
            hp2:=twin32imported_item.create(name,name,index);
            hp1.imported_items.concat(hp2);
          end;
      end;


    procedure TImportLibWin.importprocedure(aprocdef:tprocdef;const module : string;index : longint;const name : string);
      begin
        win32importproc(module,index,name);
      end;


    procedure TImportLibWin.importprocedure_str(const module : string;index : longint;const name : string);
      begin
        win32importproc(module,index,name);
      end;


    procedure TImportLibWin.importvariable(vs:tglobalvarsym;const name,module:string);
      begin
        importvariable_str(vs.mangledname,name,module);
      end;


    procedure TImportLibWin.importvariable_str(const s:string;const name,module:string);
      var
         hp1 : timportList;
         hp2 : twin32imported_item;
         hs  : string;
      begin
         hs:=AddExtension(module,target_info.sharedlibext);
         { search for the module }
         hp1:=timportlist(current_module.imports.first);
         while assigned(hp1) do
           begin
              if hs=hp1.dllname^ then
                break;
              hp1:=timportlist(hp1.next);
           end;
         { generate a new item ? }
         if not(assigned(hp1)) then
           begin
              hp1:=timportlist.create(hs);
              current_module.imports.concat(hp1);
           end;
         hp2:=twin32imported_item.create_var(s,name);
         hp1.imported_items.concat(hp2);
      end;


    procedure TImportLibWin.generateimportlib;
      var
        ObjWriter        : tarobjectwriter;
        ObjOutput        : TPECoffObjOutput;
        basedllname      : string;
        AsmPrefix        : string;
        idatalabnr,
        SmartFilesCount,
        SmartHeaderCount : longint;

        function CreateObjData(place:tcutplace):TObjData;
        var
          s : string;
        begin
          s:='';
          case place of
            cut_begin :
              begin
                inc(SmartHeaderCount);
                s:=asmprefix+tostr(SmartHeaderCount)+'h';
              end;
            cut_normal :
              s:=asmprefix+tostr(SmartHeaderCount)+'s';
            cut_end :
              s:=asmprefix+tostr(SmartHeaderCount)+'t';
          end;
          inc(SmartFilesCount);
          result:=ObjOutput.NewObjData(FixFileName(s+tostr(SmartFilesCount)+target_info.objext));
          ObjOutput.startobjectfile(Result.Name);
        end;

        procedure WriteObjData(objdata:TObjData);
        begin
          ObjOutput.writeobjectfile(ObjData);
        end;

        procedure StartImport(const dllname:string);
        var
          headlabel,
          idata4label,
          idata5label,
          idata7label : TObjSymbol;
          emptyint    : longint;
          objdata     : TObjData;
          idata2objsection,
          idata4objsection,
          idata5objsection : TObjSection;
        begin
          objdata:=CreateObjData(cut_begin);
          idata2objsection:=objdata.createsection(sec_idata2,'');
          idata4objsection:=objdata.createsection(sec_idata4,'');
          idata5objsection:=objdata.createsection(sec_idata5,'');
          emptyint:=0;
          basedllname:=splitfilename(dllname);
          { idata4 }
          objdata.SetSection(idata4objsection);
          idata4label:=objdata.SymbolDefine(asmprefix+'_names_'+basedllname,AB_GLOBAL,AT_DATA);
          { idata5 }
          objdata.SetSection(idata5objsection);
          idata5label:=objdata.SymbolDefine(asmprefix+'_fixup_'+basedllname,AB_GLOBAL,AT_DATA);
          { idata2 }
          objdata.SetSection(idata2objsection);
          headlabel:=objdata.SymbolDefine(asmprefix+'_head_'+basedllname,AB_GLOBAL,AT_DATA);
          ObjOutput.exportsymbol(headlabel);
          objdata.writereloc(0,sizeof(longint),idata4label,RELOC_RVA);
          objdata.writebytes(emptyint,sizeof(emptyint));
          objdata.writebytes(emptyint,sizeof(emptyint));
          idata7label:=objdata.SymbolRef(asmprefix+'_dll_'+basedllname);
          objdata.writereloc(0,sizeof(longint),idata7label,RELOC_RVA);
          objdata.writereloc(0,sizeof(longint),idata5label,RELOC_RVA);
          WriteObjData(objdata);
          objdata.free;
        end;

        procedure EndImport;
        var
          idata7label : TObjSymbol;
          emptyint : longint;
          objdata     : TObjData;
          idata4objsection,
          idata5objsection,
          idata7objsection : TObjSection;
        begin
          objdata:=CreateObjData(cut_end);
          idata4objsection:=objdata.createsection(sec_idata4,'');
          idata5objsection:=objdata.createsection(sec_idata5,'');
          idata7objsection:=objdata.createsection(sec_idata7,'');
          emptyint:=0;
          { idata4 }
          objdata.SetSection(idata4objsection);
          objdata.writebytes(emptyint,sizeof(emptyint));
          if target_info.system=system_x86_64_win64 then
            objdata.writebytes(emptyint,sizeof(emptyint));
          { idata5 }
          objdata.SetSection(idata5objsection);
          objdata.writebytes(emptyint,sizeof(emptyint));
          if target_info.system=system_x86_64_win64 then
            objdata.writebytes(emptyint,sizeof(emptyint));
          { idata7 }
          objdata.SetSection(idata7objsection);
          idata7label:=objdata.SymbolDefine(asmprefix+'_dll_'+basedllname,AB_GLOBAL,AT_DATA);
          objoutput.exportsymbol(idata7label);
          objdata.writebytes(basedllname[1],length(basedllname));
          objdata.writebytes(emptyint,1);
          WriteObjData(objdata);
          objdata.free;
        end;

        procedure AddImport(const afuncname:string;ordnr:word;isvar:boolean);
        const
{$ifdef x86_64}
          jmpopcode : array[0..2] of byte = (
            $ff,$24,$25
          );
{$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
          implabel,
          idata2label,
          idata5label,
          idata6label : TObjSymbol;
          emptyint : longint;
          objdata     : TObjData;
          textobjsection,
          idata4objsection,
          idata5objsection,
          idata6objsection,
          idata7objsection : TObjSection;
        begin
          objdata:=CreateObjData(cut_normal);
          if not isvar then
            textobjsection:=objdata.createsection(sec_code,'');
          idata4objsection:=objdata.createsection(sec_idata4,'');
          idata5objsection:=objdata.createsection(sec_idata5,'');
          idata6objsection:=objdata.createsection(sec_idata6,'');
          idata7objsection:=objdata.createsection(sec_idata7,'');
          emptyint:=0;
          { idata7, link to head }
          objdata.SetSection(idata7objsection);
          idata2label:=objdata.SymbolRef(asmprefix+'_head_'+basedllname);
          objdata.writereloc(0,sizeof(longint),idata2label,RELOC_RVA);
          { idata6, import data (ordnr+name) }
          objdata.SetSection(idata6objsection);
          inc(idatalabnr);
          idata6label:=objdata.SymbolDefine(asmprefix+'_'+tostr(idatalabnr),AB_LOCAL,AT_DATA);
          objdata.writebytes(ordnr,2);
          objdata.writebytes(afuncname[1],length(afuncname));
          objdata.writebytes(emptyint,1);
          objdata.writebytes(emptyint,align(objdata.CurrObjSec.size,2)-objdata.CurrObjSec.size);
          { idata4, import lookup table }
          objdata.SetSection(idata4objsection);
          if afuncname<>'' then
            begin
              objdata.writereloc(0,sizeof(longint),idata6label,RELOC_RVA);
              if target_info.system=system_x86_64_win64 then
                objdata.writebytes(emptyint,sizeof(emptyint));
            end
          else
            begin
              emptyint:=ordnr;
              if target_info.system=system_x86_64_win64 then
                begin
                  objdata.writebytes(emptyint,sizeof(emptyint));
                  emptyint:=longint($80000000);
                  objdata.writebytes(emptyint,sizeof(emptyint));
                end
              else
                begin
                  emptyint:=emptyint or longint($80000000);
                  objdata.writebytes(emptyint,sizeof(emptyint));
                end;
              emptyint:=0;
            end;
          { idata5, import address table }
          objdata.SetSection(idata5objsection);
          if isvar then
            implabel:=objdata.SymbolDefine(afuncname,AB_GLOBAL,AT_DATA)
          else
            idata5label:=objdata.SymbolDefine(asmprefix+'_'+afuncname,AB_LOCAL,AT_DATA);
          objdata.writereloc(0,sizeof(longint),idata6label,RELOC_RVA);
          if target_info.system=system_x86_64_win64 then
            objdata.writebytes(emptyint,sizeof(emptyint));
          { text, jmp }
          if not isvar then
            begin
              objdata.SetSection(textobjsection);
              if afuncname <> '' then
                implabel:=objdata.SymbolDefine(afuncname,AB_GLOBAL,AT_FUNCTION)
              else
                implabel:=objdata.SymbolDefine(basedllname+'_index_'+tostr(ordnr),AB_GLOBAL,AT_FUNCTION);
              objdata.writebytes(jmpopcode,sizeof(jmpopcode));
              objdata.writereloc(0,sizeof(longint),idata5label,RELOC_ABSOLUTE32);
              objdata.writebytes(nopopcodes,align(objdata.CurrObjSec.size,sizeof(nopopcodes))-objdata.CurrObjSec.size);
            end;
          ObjOutput.exportsymbol(implabel);
          WriteObjData(objdata);
          objdata.free;
        end;

      var
         hp1 : timportList;
         hp2 : twin32imported_item;
      begin
        AsmPrefix:='imp'+Lower(current_module.modulename^);
        idatalabnr:=0;
        SmartFilesCount:=0;
        SmartHeaderCount:=0;
        current_module.linkotherstaticlibs.add(current_module.importlibfilename^,link_always);
        ObjWriter:=TARObjectWriter.create(current_module.importlibfilename^);
        ObjOutput:=TPECoffObjOutput.Create(ObjWriter);
        hp1:=timportlist(current_module.imports.first);
        while assigned(hp1) do
          begin
            StartImport(hp1.dllname^);
            hp2:=twin32imported_item(hp1.imported_items.first);
            while assigned(hp2) do
              begin
                AddImport(hp2.name^,hp2.ordnr,hp2.is_var);
                hp2:=twin32imported_item(hp2.next);
              end;
            EndImport;
            hp1:=timportlist(hp1.next);
          end;
        ObjOutput.Free;
        ObjWriter.Free;
      end;


    procedure TImportLibWin.generateidatasection;
      var
         hp1 : timportList;
         hp2 : twin32imported_item;
         l1,l2,l3,l4 {$ifdef ARM} ,l5 {$endif ARM} : tasmlabel;
         importname : string;
         suffix : integer;
         href : treference;
      begin
         if (target_asm.id in [as_i386_masm,as_i386_tasm,as_i386_nasmwin32]) then
           begin
             new_section(current_asmdata.asmlists[al_imports],sec_code,'',0);
             hp1:=timportlist(current_module.imports.first);
             while assigned(hp1) do
               begin
                 hp2:=twin32imported_item(hp1.imported_items.first);
                 while assigned(hp2) do
                   begin
                     current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_extern,hp2.func^));
                     current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_nasm_import,hp2.func^+' '+hp1.dllname^+' '+hp2.name^));
                     hp2:=twin32imported_item(hp2.next);
                   end;
                 hp1:=timportlist(hp1.next);
               end;
             exit;
           end;

         hp1:=timportlist(current_module.imports.first);
         while assigned(hp1) do
           begin
              { align al_procedures for the jumps }
              new_section(current_asmdata.asmlists[al_imports],sec_code,'',sizeof(aint));
              { Get labels for the sections }
              current_asmdata.getjumplabel(l1);
              current_asmdata.getjumplabel(l2);
              current_asmdata.getjumplabel(l3);
              new_section(current_asmdata.asmlists[al_imports],sec_idata2,'',0);
              { pointer to procedure names }
              current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(l2));
              { two empty entries follow }
              current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));
              current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));
              { pointer to dll name }
              current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(l1));
              { pointer to fixups }
              current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(l3));

              { only create one section for each else it will
                create a lot of idata* }

              { first write the name references }
              new_section(current_asmdata.asmlists[al_imports],sec_idata4,'',0);
              current_asmdata.asmlists[al_imports].concat(Tai_label.Create(l2));

              hp2:=twin32imported_item(hp1.imported_items.first);
              while assigned(hp2) do
                begin
                   current_asmdata.getjumplabel(tasmlabel(hp2.lab));
                   if hp2.name^<>'' then
                     begin
                       current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(hp2.lab));
                       if target_info.system=system_x86_64_win64 then
                         current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));
                     end
                   else
                     begin
                       if target_info.system=system_x86_64_win64 then
                         current_asmdata.asmlists[al_imports].concat(Tai_const.Create_64bit(int64($8000000000000000) or hp2.ordnr))
                       else
                         current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(longint($80000000) or hp2.ordnr));
                     end;
                   hp2:=twin32imported_item(hp2.next);
                end;
              { finalize the names ... }
              current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));
              if target_info.system=system_x86_64_win64 then
                current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));

              { then the addresses and create also the indirect jump }
              new_section(current_asmdata.asmlists[al_imports],sec_idata5,'',0);
              current_asmdata.asmlists[al_imports].concat(Tai_label.Create(l3));

              hp2:=twin32imported_item(hp1.imported_items.first);
              while assigned(hp2) do
                begin
                   if not hp2.is_var then
                    begin
                      current_asmdata.getjumplabel(l4);
                    {$ifdef ARM}
                      current_asmdata.getjumplabel(l5);
                    {$endif ARM}
                      { create indirect jump and }
                      { place jump in al_procedures }
                      new_section(current_asmdata.asmlists[al_imports],sec_code,'',0);
                      if hp2.name^ <> '' then
                        current_asmdata.asmlists[al_imports].concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0))
                      else
                        current_asmdata.asmlists[al_imports].concat(Tai_symbol.Createname_global(splitfilename(hp1.dllname^)+'_index_'+tostr(hp2.ordnr),AT_FUNCTION,0));
                      current_asmdata.asmlists[al_imports].concat(tai_function_name.create(''));
                    {$ifdef ARM}
                      reference_reset_symbol(href,l5,0);
                      current_asmdata.asmlists[al_imports].concat(Taicpu.op_reg_ref(A_LDR,NR_R12,href));
                      reference_reset_base(href,NR_R12,0);
                      current_asmdata.asmlists[al_imports].concat(Taicpu.op_reg_ref(A_LDR,NR_R15,href));
                      current_asmdata.asmlists[al_imports].concat(Tai_label.Create(l5));
                      reference_reset_symbol(href,l4,0);
                      current_asmdata.asmlists[al_imports].concat(tai_const.create_sym_offset(href.symbol,href.offset));
                    {$else ARM}
                      reference_reset_symbol(href,l4,0);
                      current_asmdata.asmlists[al_imports].concat(Taicpu.Op_ref(A_JMP,S_NO,href));
                      current_asmdata.asmlists[al_imports].concat(Tai_align.Create_op(4,$90));
                    {$endif ARM}
                      { add jump field to al_imports }
                      new_section(current_asmdata.asmlists[al_imports],sec_idata5,'',0);
                      if (cs_debuginfo in aktmoduleswitches) then
                       begin
                         if assigned(hp2.name) then
                          begin
                            importname:='__imp_'+hp2.name^;
                            suffix:=0;
                            while assigned(current_asmdata.getasmsymbol(importname)) do
                             begin
                               inc(suffix);
                               importname:='__imp_'+hp2.name^+'_'+tostr(suffix);
                             end;
                            current_asmdata.asmlists[al_imports].concat(tai_symbol.createname(importname,AT_FUNCTION,4));
                          end
                         else
                          begin
                            importname:='__imp_by_ordinal'+tostr(hp2.ordnr);
                            suffix:=0;
                            while assigned(current_asmdata.getasmsymbol(importname)) do
                             begin
                               inc(suffix);
                               importname:='__imp_by_ordinal'+tostr(hp2.ordnr)+'_'+tostr(suffix);
                             end;
                            current_asmdata.asmlists[al_imports].concat(tai_symbol.createname(importname,AT_FUNCTION,4));
                          end;
                       end;
                      current_asmdata.asmlists[al_imports].concat(Tai_label.Create(l4));
                    end
                   else
                    begin
                      current_asmdata.asmlists[al_imports].concat(Tai_symbol.Createname_global(hp2.func^,AT_DATA,0));
                    end;
                   current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(hp2.lab));
                   if target_info.system=system_x86_64_win64 then
                     current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));
                   hp2:=twin32imported_item(hp2.next);
                end;
              { finalize the addresses }
              current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));
              if target_info.system=system_x86_64_win64 then
                current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));

              { finally the import information }
              new_section(current_asmdata.asmlists[al_imports],sec_idata6,'',0);
              hp2:=twin32imported_item(hp1.imported_items.first);
              while assigned(hp2) do
                begin
                   current_asmdata.asmlists[al_imports].concat(Tai_label.Create(hp2.lab));
                   { the ordinal number }
                   current_asmdata.asmlists[al_imports].concat(Tai_const.Create_16bit(hp2.ordnr));
                   current_asmdata.asmlists[al_imports].concat(Tai_string.Create(hp2.name^+#0));
                   current_asmdata.asmlists[al_imports].concat(Tai_align.Create_op(2,0));
                   hp2:=twin32imported_item(hp2.next);
                end;
              { create import dll name }
              new_section(current_asmdata.asmlists[al_imports],sec_idata7,'',0);
              current_asmdata.asmlists[al_imports].concat(Tai_label.Create(l1));
              current_asmdata.asmlists[al_imports].concat(Tai_string.Create(hp1.dllname^+#0));

              hp1:=timportlist(hp1.next);
           end;
      end;


    procedure TImportLibWin.generatelib;
      begin
        if GenerateImportSection then
          generateidatasection
        else
          generateimportlib;
      end;


{*****************************************************************************
                             TExportLibWin
*****************************************************************************}

    procedure TExportLibWin.preparelib(const s:string);
      begin
         if current_asmdata.asmlists[al_exports]=nil then
           current_asmdata.asmlists[al_exports]:=TAsmList.create;
         EList_indexed:=tFPList.Create;
         EList_nonindexed:=tFPList.Create;
      end;


    procedure TExportLibWin.exportvar(hp : texported_item);
      begin
         { same code used !! PM }
         exportprocedure(hp);
      end;

    var
      Gl_DoubleIndex:boolean;
      Gl_DoubleIndexValue:longint;

    function IdxCompare(Item1, Item2: Pointer): Integer;
      var
        I1:texported_item absolute Item1;
        I2:texported_item absolute Item2;
      begin
        Result:=I1.index-I2.index;
        if(Result=0)and(Item1<>Item2)then
         begin
          Gl_DoubleIndex:=true;
          Gl_DoubleIndexValue:=I1.index;
         end;
      end;


    procedure TExportLibWin.exportprocedure(hp : texported_item);
      begin
        if ((hp.options and eo_index)<>0)and((hp.index<=0) or (hp.index>$ffff)) then
          begin
           message1(parser_e_export_invalid_index,tostr(hp.index));
           exit;
          end;
        if hp.options and eo_index=eo_index then
          EList_indexed.Add(hp)
        else
          EList_nonindexed.Add(hp);
      end;


    procedure TExportLibWin.exportfromlist(hp : texported_item);
      //formerly TExportLibWin.exportprocedure
      { must be ordered at least for win32 !! }
      var
        hp2 : texported_item;
      begin
        hp2:=texported_item(current_module._exports.first);
        while assigned(hp2) and
           (hp.name^>hp2.name^) do
          hp2:=texported_item(hp2.next);
        { insert hp there !! }
        if hp2=nil then
          current_module._exports.concat(hp)
        else
          begin
            if hp2.name^=hp.name^ then
              begin
                { this is not allowed !! }
                message1(parser_e_export_name_double,hp.name^);
                exit;
              end;
            current_module._exports.insertbefore(hp,hp2);
          end;
      end;


    procedure TExportLibWin.generatelib;
      var
         ordinal_base,ordinal_max,ordinal_min : longint;
         current_index : longint;
         entries,named_entries : longint;
         name_label,dll_name_label,export_address_table : tasmlabel;
         export_name_table_pointers,export_ordinal_table : tasmlabel;
         hp,hp2 : texported_item;
         temtexport : TLinkedList;
         address_table,name_table_pointers,
         name_table,ordinal_table : TAsmList;
         i,autoindex,ni_high : longint;
         hole : boolean;

      begin
         Gl_DoubleIndex:=false;
         ELIst_indexed.Sort(@IdxCompare);

         if Gl_DoubleIndex then
           begin
             message1(parser_e_export_ordinal_double,tostr(Gl_DoubleIndexValue));
             EList_indexed.Free;
             EList_nonindexed.Free;
             exit;
           end;

         autoindex:=1;
         while EList_nonindexed.Count>0 do
          begin
           hole:=(EList_indexed.Count>0)and(texported_item(EList_indexed.Items[0]).index>1);
           if not hole then
            for i:=autoindex to pred(EList_indexed.Count)do
             if texported_item(EList_indexed.Items[i]).index-texported_item(EList_indexed.Items[pred(i)]).index>1 then
              begin
               autoindex:=succ(texported_item(EList_indexed.Items[pred(i)]).index);
               hole:=true;
               break;
              end;
           ni_high:=pred(EList_nonindexed.Count);
           if not hole then
            begin
             autoindex:=succ(EList_indexed.Count);
             EList_indexed.Add(EList_nonindexed.Items[ni_high]);
            end
           else
            EList_indexed.Insert(pred(AutoIndex),EList_nonindexed.Items[ni_high]);
           EList_nonindexed.Delete(ni_high);
           texported_item(EList_indexed.Items[pred(AutoIndex)]).index:=autoindex;
          end;
         EList_nonindexed.Free;
         for i:=0 to pred(EList_indexed.Count)do
          exportfromlist(texported_item(EList_indexed.Items[i]));
         EList_indexed.Free;

         if (target_asm.id in [as_i386_masm,as_i386_tasm,as_i386_nasmwin32]) then
          begin
            generatenasmlib;
            exit;
          end;

         hp:=texported_item(current_module._exports.first);
         if not assigned(hp) then
           exit;

         ordinal_max:=0;
         ordinal_min:=$7FFFFFFF;
         entries:=0;
         named_entries:=0;
         current_asmdata.getjumplabel(dll_name_label);
         current_asmdata.getjumplabel(export_address_table);
         current_asmdata.getjumplabel(export_name_table_pointers);
         current_asmdata.getjumplabel(export_ordinal_table);

         { count entries }
         while assigned(hp) do
           begin
              inc(entries);
              if (hp.index>ordinal_max) then
                ordinal_max:=hp.index;
              if (hp.index>0) and (hp.index<ordinal_min) then
                ordinal_min:=hp.index;
              if assigned(hp.name) then
                inc(named_entries);
              hp:=texported_item(hp.next);
           end;

         { no support for higher ordinal base yet !! }
         ordinal_base:=1;
         current_index:=ordinal_base;
         { we must also count the holes !! }
         entries:=ordinal_max-ordinal_base+1;

         new_section(current_asmdata.asmlists[al_exports],sec_edata,'',0);
         { create label to reference from main so smartlink will include
           the .edata section }
         current_asmdata.asmlists[al_exports].concat(Tai_symbol.Createname_global(make_mangledname('EDATA',current_module.localsymtable,''),AT_DATA,0));
         { export flags }
         current_asmdata.asmlists[al_exports].concat(Tai_const.Create_32bit(0));
         { date/time stamp }
         current_asmdata.asmlists[al_exports].concat(Tai_const.Create_32bit(0));
         { major version }
         current_asmdata.asmlists[al_exports].concat(Tai_const.Create_16bit(0));
         { minor version }
         current_asmdata.asmlists[al_exports].concat(Tai_const.Create_16bit(0));
         { pointer to dll name }
         current_asmdata.asmlists[al_exports].concat(Tai_const.Create_rva_sym(dll_name_label));
         { ordinal base normally set to 1 }
         current_asmdata.asmlists[al_exports].concat(Tai_const.Create_32bit(ordinal_base));
         { number of entries }
         current_asmdata.asmlists[al_exports].concat(Tai_const.Create_32bit(entries));
         { number of named entries }
         current_asmdata.asmlists[al_exports].concat(Tai_const.Create_32bit(named_entries));
         { address of export address table }
         current_asmdata.asmlists[al_exports].concat(Tai_const.Create_rva_sym(export_address_table));
         { address of name pointer pointers }
         current_asmdata.asmlists[al_exports].concat(Tai_const.Create_rva_sym(export_name_table_pointers));
         { address of ordinal number pointers }
         current_asmdata.asmlists[al_exports].concat(Tai_const.Create_rva_sym(export_ordinal_table));
         { the name }
         current_asmdata.asmlists[al_exports].concat(Tai_label.Create(dll_name_label));
         if st='' then
           current_asmdata.asmlists[al_exports].concat(Tai_string.Create(current_module.modulename^+target_info.sharedlibext+#0))
         else
           current_asmdata.asmlists[al_exports].concat(Tai_string.Create(st+target_info.sharedlibext+#0));

         {  export address table }
         address_table:=TAsmList.create;
         address_table.concat(Tai_align.Create_op(4,0));
         address_table.concat(Tai_label.Create(export_address_table));
         name_table_pointers:=TAsmList.create;
         name_table_pointers.concat(Tai_align.Create_op(4,0));
         name_table_pointers.concat(Tai_label.Create(export_name_table_pointers));
         ordinal_table:=TAsmList.create;
         ordinal_table.concat(Tai_align.Create_op(4,0));
         ordinal_table.concat(Tai_label.Create(export_ordinal_table));
         name_table:=TAsmList.Create;
         name_table.concat(Tai_align.Create_op(4,0));
         { write each address }
         hp:=texported_item(current_module._exports.first);
         while assigned(hp) do
           begin
              if (hp.options and eo_name)<>0 then
                begin
                   current_asmdata.getjumplabel(name_label);
                   name_table_pointers.concat(Tai_const.Create_rva_sym(name_label));
                   ordinal_table.concat(Tai_const.Create_16bit(hp.index-ordinal_base));
                   name_table.concat(Tai_align.Create_op(2,0));
                   name_table.concat(Tai_label.Create(name_label));
                   name_table.concat(Tai_string.Create(hp.name^+#0));
                end;
              hp:=texported_item(hp.next);
           end;
         { order in increasing ordinal values }
         { into temtexport list }
         temtexport:=TLinkedList.Create;
         hp:=texported_item(current_module._exports.first);
         while assigned(hp) do
           begin
              current_module._exports.remove(hp);
              hp2:=texported_item(temtexport.first);
              while assigned(hp2) and (hp.index>hp2.index) do
                hp2:=texported_item(hp2.next);
              if hp2=nil then
                temtexport.concat(hp)
              else
                temtexport.insertbefore(hp,hp2);
              hp:=texported_item(current_module._exports.first);;
           end;

         { write the export adress table }
         current_index:=ordinal_base;
         hp:=texported_item(temtexport.first);
         while assigned(hp) do
           begin
              { fill missing values }
              while current_index<hp.index do
                begin
                   address_table.concat(Tai_const.Create_32bit(0));
                   inc(current_index);
                end;
              case hp.sym.typ of
                globalvarsym :
                  address_table.concat(Tai_const.Createname_rva(tglobalvarsym(hp.sym).mangledname));
                typedconstsym :
                  address_table.concat(Tai_const.Createname_rva(ttypedconstsym(hp.sym).mangledname));
                procsym :
                  address_table.concat(Tai_const.Createname_rva(tprocsym(hp.sym).first_procdef.mangledname));
              end;
              inc(current_index);
              hp:=texported_item(hp.next);
           end;

         current_asmdata.asmlists[al_exports].concatlist(address_table);
         current_asmdata.asmlists[al_exports].concatlist(name_table_pointers);
         current_asmdata.asmlists[al_exports].concatlist(ordinal_table);
         current_asmdata.asmlists[al_exports].concatlist(name_table);
         address_table.Free;
         name_table_pointers.free;
         ordinal_table.free;
         name_table.free;
         temtexport.free;
      end;


    procedure TExportLibWin.generatenasmlib;
      var
         hp : texported_item;
         p  : pchar;
         s  : string;
      begin
         new_section(current_asmdata.asmlists[al_exports],sec_code,'',0);
         hp:=texported_item(current_module._exports.first);
         while assigned(hp) do
           begin
             case hp.sym.typ of
               globalvarsym :
                 s:=tglobalvarsym(hp.sym).mangledname;
               typedconstsym :
                 s:=ttypedconstsym(hp.sym).mangledname;
               procsym :
                 s:=tprocsym(hp.sym).first_procdef.mangledname;
               else
                 s:='';
             end;
             p:=strpnew(#9+'export '+s+' '+hp.name^+' '+tostr(hp.index));
             {current_asmdata.asmlists[al_exports].concat(tai_direct.create(p));}
             hp:=texported_item(hp.next);
           end;
      end;


{****************************************************************************
                            TInternalLinkerWin
****************************************************************************}

    constructor TInternalLinkerWin.Create;
      begin
        inherited Create;
        CExeoutput:=TPECoffexeoutput;
        CObjInput:=TPECoffObjInput;
      end;


    procedure TInternalLinkerWin.DefaultLinkScript;
      var
        s,s2,
        ibase : string;
      begin
        with LinkScript do
          begin
            while not ObjectFiles.Empty do
              begin
                s:=ObjectFiles.GetFirst;
                if s<>'' then
                  Concat('READOBJECT '+s);
              end;
            while not StaticLibFiles.Empty do
              begin
                s:=StaticLibFiles.GetFirst;
                if s<>'' then
                  Concat('READSTATICLIBRARY '+s);
              end;
            While not SharedLibFiles.Empty do
              begin
                S:=SharedLibFiles.GetFirst;
                if FindLibraryFile(s,target_info.staticClibprefix,target_info.staticClibext,s2) then
                  Concat('READSTATICLIBRARY '+s2)
                else
                  Comment(V_Error,'Import library not found for '+S);
              end;
            if IsSharedLibrary then
              begin
                Concat('ISSHAREDLIBRARY');
                if apptype=app_gui then
                  Concat('ENTRYNAME _DLLWinMainCRTStartup')
                else
                  Concat('ENTRYNAME _DLLMainCRTStartup');
              end
            else
              begin
                if apptype=app_gui then
                  Concat('ENTRYNAME _WinMainCRTStartup')
                else
                  Concat('ENTRYNAME _mainCRTStartup');
              end;
            ibase:='';
            if assigned(DLLImageBase) then
              ibase:=DLLImageBase^
            else
              begin
                if target_info.system in [system_arm_wince] then
                  ibase:='10000'
                else
                  begin
                    if IsSharedLibrary then
                      ibase:='10000000'
                    else
                      ibase:='400000';
                  end;
              end;
            Concat('IMAGEBASE $' + ibase);
            Concat('HEADER');
            Concat('EXESECTION .text');
            if target_info.system=system_arm_wince then
              Concat('  OBJSECTION .pdata.FPC_EH_PROLOG');
            Concat('  OBJSECTION .text*');
            Concat('  SYMBOL ___CTOR_LIST__');
            Concat('  SYMBOL __CTOR_LIST__');
            Concat('  LONG -1');
            Concat('  OBJSECTION .ctor*');
            Concat('  LONG 0');
            Concat('  SYMBOL ___DTOR_LIST__');
            Concat('  SYMBOL __DTOR_LIST__');
            Concat('  LONG -1');
            Concat('  OBJSECTION .dtor*');
            Concat('  LONG 0');
            Concat('  SYMBOL etext');
            Concat('ENDEXESECTION');
            Concat('EXESECTION .data');
            Concat('  SYMBOL __data_start__');
            Concat('  OBJSECTION .data*');
            Concat('  SYMBOL edata');
            Concat('  SYMBOL __data_end__');
            Concat('ENDEXESECTION');
            Concat('EXESECTION .rdata');
            Concat('  SYMBOL ___RUNTIME_PSEUDO_RELOC_LIST__');
            Concat('  SYMBOL __RUNTIME_PSEUDO_RELOC_LIST__');
            Concat('  OBJSECTION .rdata_runtime_pseudo_reloc');
            Concat('  SYMBOL ___RUNTIME_PSEUDO_RELOC_LIST_END__');
            Concat('  SYMBOL __RUNTIME_PSEUDO_RELOC_LIST_END__');
            Concat('  OBJSECTION .rdata*');
            Concat('  OBJSECTION .rodata*');
            Concat('ENDEXESECTION');
            Concat('EXESECTION .pdata');
            Concat('  OBJSECTION .pdata');
            Concat('ENDEXESECTION');
            Concat('EXESECTION .bss');
            Concat('  SYMBOL __bss_start__');
            Concat('  OBJSECTION .bss*');
            Concat('  SYMBOL __bss_end__');
            Concat('ENDEXESECTION');
            Concat('EXESECTION .idata');
            Concat('  OBJSECTION .idata$2*');
            Concat('  OBJSECTION .idata$3*');
            Concat('  ZEROS 20');
            Concat('  OBJSECTION .idata$4*');
            Concat('  OBJSECTION .idata$5*');
            Concat('  OBJSECTION .idata$6*');
            Concat('  OBJSECTION .idata$7*');
            Concat('ENDEXESECTION');
            Concat('EXESECTION .edata');
            Concat('  OBJSECTION .edata*');
            Concat('ENDEXESECTION');
            Concat('EXESECTION .rsrc');
            Concat('  OBJSECTION .rsrc*');
            Concat('ENDEXESECTION');
            Concat('EXESECTION .stab');
            Concat('  OBJSECTION .stab');
            Concat('ENDEXESECTION');
            Concat('EXESECTION .stabstr');
            Concat('  OBJSECTION .stabstr');
            Concat('ENDEXESECTION');
            Concat('STABS');
            Concat('SYMBOLS');
          end;
      end;



{****************************************************************************
                              TExternalLinkerWin
****************************************************************************}

    Constructor TExternalLinkerWin.Create;
      begin
        Inherited Create;
        { allow duplicated libs (PM) }
        SharedLibFiles.doubles:=true;
        StaticLibFiles.doubles:=true;
      end;


    Procedure TExternalLinkerWin.SetDefaultInfo;
      var
        targetopts: string;
      begin
        with Info do
         begin
           if target_info.system=system_arm_wince then
             targetopts:='-m armpe'
           else
             targetopts:='-b pe-i386 -m i386pe';
           ExeCmd[1]:='ld '+targetopts+' $OPT $GCSECTIONS $MAP $STRIP $APPTYPE $ENTRY  $IMAGEBASE $RELOC -o $EXE $RES';
           DllCmd[1]:='ld '+targetopts+' $OPT $GCSECTIONS $MAP $STRIP --dll $APPTYPE $ENTRY  $IMAGEBASE $RELOC -o $EXE $RES';
           { ExeCmd[2]:='dlltool --as $ASBIN --dllname $EXE --output-exp exp.$$$ $RELOC $DEF';
             use short forms to avoid 128 char limitation problem }
           ExeCmd[2]:='dlltool -S $ASBIN -D $EXE -e exp.$$$ $RELOC $DEF';
           ExeCmd[3]:='ld '+targetopts+' $OPT $STRIP $APPTYPE $ENTRY $IMAGEBASE -o $EXE $RES exp.$$$';
           { DllCmd[2]:='dlltool --as $ASBIN --dllname $EXE --output-exp exp.$$$ $RELOC $DEF'; }
           DllCmd[2]:='dlltool -S $ASBIN -D $EXE -e exp.$$$ $RELOC $DEF';
           DllCmd[3]:='ld '+targetopts+' $OPT $STRIP --dll $APPTYPE $ENTRY  $IMAGEBASE -o $EXE $RES exp.$$$';
         end;
      end;



    Function TExternalLinkerWin.WriteResponseFile(isdll:boolean) : Boolean;
      Var
        linkres : TLinkRes;
        HPath   : TStringListItem;
        s,s2    : string;
        i       : integer;
        linklibcygwin : boolean;
      begin
        WriteResponseFile:=False;
        linklibcygwin:=(SharedLibFiles.Find('cygwin')<>nil);

        if (cs_profile in aktmoduleswitches) then
          begin
            SharedLibFiles.Concat('gmon');
            SharedLibFiles.Concat('c');
            SharedLibFiles.Concat('gcc');
            SharedLibFiles.Concat('kernel32');
          end;

        { Open link.res file }
        LinkRes:=TLinkres.Create(outputexedir+Info.ResName);
        with linkres do
          begin
            { Write path to search libraries }
            HPath:=TStringListItem(current_module.locallibrarysearchpath.First);
            while assigned(HPath) do
             begin
               Add('SEARCH_DIR('+MaybeQuoted(HPath.Str)+')');
               HPath:=TStringListItem(HPath.Next);
             end;
            HPath:=TStringListItem(LibrarySearchPath.First);
            while assigned(HPath) do
             begin
               Add('SEARCH_DIR('+MaybeQuoted(HPath.Str)+')');
               HPath:=TStringListItem(HPath.Next);
             end;

            { add objectfiles, start with prt0 always                  }
            { profiling of shared libraries is currently not supported }
            if not ObjectFiles.Empty then
              begin
                Add('INPUT(');
                while not ObjectFiles.Empty do
                 begin
                   s:=ObjectFiles.GetFirst;
                   if s<>'' then
                    AddFileName(MaybeQuoted(s));
                 end;
                Add(')');
              end;

            { Write staticlibraries }
            if (not StaticLibFiles.Empty) then
             begin
               Add('GROUP(');
               While not StaticLibFiles.Empty do
                begin
                  S:=StaticLibFiles.GetFirst;
                  AddFileName(MaybeQuoted(s));
                end;
               Add(')');
             end;

            { Write sharedlibraries (=import libraries) }
            if not SharedLibFiles.Empty then
             begin
               Add('INPUT(') ;
               While not SharedLibFiles.Empty do
                begin
                  S:=SharedLibFiles.GetFirst;
                  if FindLibraryFile(s,target_info.staticClibprefix,target_info.staticClibext,s2) then
                    begin
                      Add(MaybeQuoted(s2));
                      continue;
                    end;
                  if pos(target_info.sharedlibprefix,s)=1 then
                    s:=copy(s,length(target_info.sharedlibprefix)+1,255);
                  i:=Pos(target_info.sharedlibext,S);
                  if i>0 then
                   Delete(S,i,255);
                  Add('-l'+s);
                end;
               Add(')');
             end;

            Add('SEARCH_DIR("/usr/i686-pc-cygwin/lib"); SEARCH_DIR("/usr/lib"); SEARCH_DIR("/usr/lib/w32api");');
            Add('OUTPUT_FORMAT(pei-i386)');
            Add('ENTRY(_mainCRTStartup)');
            Add('SECTIONS');
            Add('{');
            Add('  . = SIZEOF_HEADERS;');
            Add('  . = ALIGN(__section_alignment__);');
            Add('  .text  __image_base__ + ( __section_alignment__ < 0x1000 ? . : __section_alignment__ ) :');
            Add('  {');
{$ifdef arm}
            Add('    *(.pdata.FPC_EH_PROLOG)');
{$endif arm}
            Add('    *(.init)');
            add('    *(.text .stub .text.* .gnu.linkonce.t.*)');
            Add('    *(SORT(.text$*))');
            Add('     ___CTOR_LIST__ = .; __CTOR_LIST__ = . ;');
            Add('			LONG (-1);*(.ctors); *(.ctor); *(SORT(.ctors.*));  LONG (0);');
            Add('     ___DTOR_LIST__ = .; __DTOR_LIST__ = . ;');
            Add('			LONG (-1); *(.dtors); *(.dtor); *(SORT(.dtors.*));  LONG (0);');
            Add('     *(.fini)');
            Add('    PROVIDE (etext = .);');
            Add('    *(.gcc_except_table)');
            Add('  }');
            Add('  .data BLOCK(__section_alignment__) :');
            Add('  {');
            Add('    __data_start__ = . ;');
            add('    *(.data .data.* .gnu.linkonce.d.*)');
            Add('    *(.data2)');
            Add('    *(SORT(.data$*))');
            Add('    __data_end__ = . ;');
            Add('    *(.data_cygwin_nocopy)');
            Add('  }');
            Add('  .rdata BLOCK(__section_alignment__) :');
            Add('  {');
            Add('    *(.rdata)');
            add('    *(.rodata .rodata.* .gnu.linkonce.r.*)');
            Add('    *(SORT(.rdata$*))');
            Add('    *(.eh_frame)');
            Add('    ___RUNTIME_PSEUDO_RELOC_LIST__ = .;');
            Add('    __RUNTIME_PSEUDO_RELOC_LIST__ = .;');
            Add('    *(.rdata_runtime_pseudo_reloc)');
            Add('    ___RUNTIME_PSEUDO_RELOC_LIST_END__ = .;');
            Add('    __RUNTIME_PSEUDO_RELOC_LIST_END__ = .;');
            Add('  }');
            Add('  .pdata BLOCK(__section_alignment__) : { *(.pdata) }');
            Add('  .bss BLOCK(__section_alignment__) :');
            Add('  {');
            Add('    __bss_start__ = . ;');
            Add('    *(.bss .bss.* .gnu.linkonce.b.*)');
            Add('    *(SORT(.bss$*))');
            Add('    *(COMMON)');
            Add('    __bss_end__ = . ;');
            Add('  }');
            Add('  .edata BLOCK(__section_alignment__) : { *(.edata) }');
            Add('  .idata BLOCK(__section_alignment__) :');
            Add('  {');
            Add('    SORT(*)(.idata$2)');
            Add('    SORT(*)(.idata$3)');
            Add('    /* These zeroes mark the end of the import list.  */');
            Add('    LONG (0); LONG (0); LONG (0); LONG (0); LONG (0);');
            Add('    SORT(*)(.idata$4)');
            Add('    SORT(*)(.idata$5)');
            Add('    SORT(*)(.idata$6)');
            Add('    SORT(*)(.idata$7)');
            Add('  }');
            Add('  .CRT BLOCK(__section_alignment__) :');
            Add('  {');
            Add('    ___crt_xc_start__ = . ;');
            Add('    *(SORT(.CRT$XC*))  /* C initialization */');
            Add('    ___crt_xc_end__ = . ;');
            Add('    ___crt_xi_start__ = . ;');
            Add('    *(SORT(.CRT$XI*))  /* C++ initialization */');
            Add('    ___crt_xi_end__ = . ;');
            Add('    ___crt_xl_start__ = . ;');
            Add('    *(SORT(.CRT$XL*))  /* TLS callbacks */');
            Add('    /* ___crt_xl_end__ is defined in the TLS Directory support code */');
            Add('    ___crt_xp_start__ = . ;');
            Add('    *(SORT(.CRT$XP*))  /* Pre-termination */');
            Add('    ___crt_xp_end__ = . ;');
            Add('    ___crt_xt_start__ = . ;');
            Add('    *(SORT(.CRT$XT*))  /* Termination */');
            Add('    ___crt_xt_end__ = . ;');
            Add('  }');
            Add('  .tls BLOCK(__section_alignment__) :');
            Add('  {');
            Add('    ___tls_start__ = . ;');
            Add('    *(.tls .tls.*)');
            Add('    *(.tls$)');
            Add('    *(SORT(.tls$*))');
            Add('    ___tls_end__ = . ;');
            Add('  }');
            Add('  .rsrc BLOCK(__section_alignment__) :');
            Add('  {');
            Add('    *(.rsrc)');
            Add('    *(SORT(.rsrc$*))');
            Add('  }');
            Add('  .reloc BLOCK(__section_alignment__) : { *(.reloc) }');
            Add('  .stab BLOCK(__section_alignment__) (NOLOAD) : { *(.stab) }');
            Add('  .stabstr BLOCK(__section_alignment__) (NOLOAD) : { *(.stabstr) }');
            Add('  .debug_aranges BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_aranges) }');
            Add('  .debug_pubnames BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_pubnames) }');
            Add('  .debug_info BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_info) *(.gnu.linkonce.wi.*) }');
            Add('  .debug_abbrev BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_abbrev) }');
            Add('  .debug_line BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_line) }');
            Add('  .debug_frame BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_frame) }');
            Add('  .debug_str BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_str) }');
            Add('  .debug_loc BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_loc) }');
            Add('  .debug_macinfo BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_macinfo) }');
            Add('  .debug_weaknames BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_weaknames) }');
            Add('  .debug_funcnames BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_funcnames) }');
            Add('  .debug_typenames BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_typenames) }');
            Add('  .debug_varnames BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_varnames) }');
            Add('  .debug_ranges BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_ranges) }');
            Add('}');

            { Write and Close response }
            writetodisk;
            Free;
          end;

        WriteResponseFile:=True;
      end;


    function TExternalLinkerWin.MakeExecutable:boolean;
      var
        MapStr,
        binstr : String;
        cmdstr  : TCmdStr;
        success : boolean;
        cmds,i       : longint;
        AsBinStr     : string[80];
        GCSectionsStr,
        StripStr,
        RelocStr,
        AppTypeStr,
        EntryStr,
        ImageBaseStr : string[40];
      begin
        if not(cs_link_nolink in aktglobalswitches) then
         Message1(exec_i_linking,current_module.exefilename^);

        { Create some replacements }
        RelocStr:='';
        AppTypeStr:='';
        EntryStr:='';
        ImageBaseStr:='';
        StripStr:='';
        MapStr:='';
        GCSectionsStr:='';
        AsBinStr:=FindUtil(utilsprefix+'as');
        if RelocSection then
          RelocStr:='--base-file base.$$$';
        if use_smartlink_section then
          GCSectionsStr:='--gc-sections';
        if target_info.system in [system_arm_wince,system_i386_wince] then
          AppTypeStr:='--subsystem wince'
        else
          begin
            if apptype=app_gui then
              AppTypeStr:='--subsystem windows';
          end;
        if apptype=app_gui then
          EntryStr:='--entry=_WinMainCRTStartup'
        else
          EntryStr:='--entry=_mainCRTStartup';
        if assigned(DLLImageBase) then
          ImageBaseStr:='--image-base=0x'+DLLImageBase^;
        if (cs_link_strip in aktglobalswitches) then
          StripStr:='-s';
        if (cs_link_map in aktglobalswitches) then
          MapStr:='-Map '+maybequoted(ForceExtension(current_module.exefilename^,'.map'));

      { Write used files and libraries }
        WriteResponseFile(false);

      { Call linker }
        success:=false;
        if RelocSection or (not Deffile.empty) then
          cmds:=3
        else
          cmds:=1;
        for i:=1 to cmds do
         begin
           SplitBinCmd(Info.ExeCmd[i],binstr,cmdstr);
           if binstr<>'' then
            begin
              Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^));
              Replace(cmdstr,'$OPT',Info.ExtraOptions);
              Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName));
              Replace(cmdstr,'$APPTYPE',AppTypeStr);
              Replace(cmdstr,'$ENTRY',EntryStr);
              Replace(cmdstr,'$ASBIN',AsbinStr);
              Replace(cmdstr,'$RELOC',RelocStr);
              Replace(cmdstr,'$IMAGEBASE',ImageBaseStr);
              Replace(cmdstr,'$GCSECTIONS',GCSectionsStr);
              Replace(cmdstr,'$STRIP',StripStr);
              Replace(cmdstr,'$MAP',MapStr);
              if not DefFile.Empty then
                begin
                  DefFile.WriteFile;
                  Replace(cmdstr,'$DEF','-d '+maybequoted(deffile.fname));
                end
              else
                Replace(cmdstr,'$DEF','');
              success:=DoExec(FindUtil(utilsprefix+binstr),cmdstr,(i=1),false);
              if not success then
               break;
            end;
         end;

      { Post process }
        if success then
         success:=PostProcessExecutable(current_module.exefilename^,false);

      { Remove ReponseFile }
        if (success) and not(cs_link_nolink in aktglobalswitches) then
         begin
           RemoveFile(outputexedir+Info.ResName);
           RemoveFile('base.$$$');
           RemoveFile('exp.$$$');
           RemoveFile('deffile.$$$');
         end;

        MakeExecutable:=success;   { otherwise a recursive call to link method }
      end;


    Function TExternalLinkerWin.MakeSharedLibrary:boolean;
      var
        MapStr,
        binstr : String;
        cmdstr  : TCmdStr;
        success : boolean;
        cmds,
        i       : longint;
        AsBinStr     : string[80];
        StripStr,
        GCSectionsStr,
        RelocStr,
        AppTypeStr,
        EntryStr,
        ImageBaseStr : string[40];
      begin
        MakeSharedLibrary:=false;
        if not(cs_link_nolink in aktglobalswitches) then
         Message1(exec_i_linking,current_module.sharedlibfilename^);

      { Create some replacements }
        RelocStr:='';
        AppTypeStr:='';
        EntryStr:='';
        ImageBaseStr:='';
        StripStr:='';
        MapStr:='';
        GCSectionsStr:='';
        AsBinStr:=FindUtil(utilsprefix+'as');
        if RelocSection then
         RelocStr:='--base-file base.$$$';
        if use_smartlink_section then
         GCSectionsStr:='--gc-sections';
        if apptype=app_gui then
          begin
            AppTypeStr:='--subsystem windows';
            EntryStr:='--entry _DLLWinMainCRTStartup'
          end
        else
          EntryStr:='--entry _DLLMainCRTStartup';
        if assigned(DLLImageBase) then
          ImageBaseStr:='--image-base=0x'+DLLImageBase^;
        if (cs_link_strip in aktglobalswitches) then
          StripStr:='-s';
        if (cs_link_map in aktglobalswitches) then
          MapStr:='-Map '+maybequoted(ForceExtension(current_module.exefilename^,'.map'));

      { Write used files and libraries }
        WriteResponseFile(true);

      { Call linker }
        success:=false;
        if RelocSection or (not Deffile.empty) then
          cmds:=3
        else
          cmds:=1;
        for i:=1 to cmds do
         begin
           SplitBinCmd(Info.DllCmd[i],binstr,cmdstr);
           if binstr<>'' then
            begin
              Replace(cmdstr,'$EXE',maybequoted(current_module.sharedlibfilename^));
              Replace(cmdstr,'$OPT',Info.ExtraOptions);
              Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName));
              Replace(cmdstr,'$APPTYPE',AppTypeStr);
              Replace(cmdstr,'$ENTRY',EntryStr);
              Replace(cmdstr,'$ASBIN',AsbinStr);
              Replace(cmdstr,'$RELOC',RelocStr);
              Replace(cmdstr,'$IMAGEBASE',ImageBaseStr);
              Replace(cmdstr,'$STRIP',StripStr);
              Replace(cmdstr,'$GCSECTIONS',GCSectionsStr);
              Replace(cmdstr,'$MAP',MapStr);
              if not DefFile.Empty then
                begin
                  DefFile.WriteFile;
                  Replace(cmdstr,'$DEF','-d '+maybequoted(deffile.fname));
                end
              else
                Replace(cmdstr,'$DEF','');
              success:=DoExec(FindUtil(utilsprefix+binstr),cmdstr,(i=1),false);
              if not success then
               break;
            end;
         end;

      { Post process }
        if success then
         success:=PostProcessExecutable(current_module.sharedlibfilename^,true);

      { Remove ReponseFile }
        if (success) and not(cs_link_nolink in aktglobalswitches) then
         begin
           RemoveFile(outputexedir+Info.ResName);
           RemoveFile('base.$$$');
           RemoveFile('exp.$$$');
           RemoveFile('deffile.$$$');
         end;
        MakeSharedLibrary:=success;   { otherwise a recursive call to link method }
      end;


    function TExternalLinkerWin.postprocessexecutable(const fn : string;isdll:boolean):boolean;
      type
        tdosheader = packed record
           e_magic : word;
           e_cblp : word;
           e_cp : word;
           e_crlc : word;
           e_cparhdr : word;
           e_minalloc : word;
           e_maxalloc : word;
           e_ss : word;
           e_sp : word;
           e_csum : word;
           e_ip : word;
           e_cs : word;
           e_lfarlc : word;
           e_ovno : word;
           e_res : array[0..3] of word;
           e_oemid : word;
           e_oeminfo : word;
           e_res2 : array[0..9] of word;
           e_lfanew : longint;
        end;
        psecfill=^TSecfill;
        TSecfill=record
          fillpos,
          fillsize : longint;
          next : psecfill;
        end;
      var
        f : file;
        cmdstr : string;
        dosheader : tdosheader;
        peheader : tcoffheader;
        peoptheader : tcoffpeoptheader;
        firstsecpos,
        maxfillsize,
        l,peheaderpos : longint;
        coffsec : tcoffsechdr;
        secroot,hsecroot : psecfill;
        zerobuf : pointer;
      begin
        postprocessexecutable:=false;
        { when -s is used or it's a dll then quit }
        if (cs_link_nolink in aktglobalswitches) then
         begin
           case apptype of
             app_native :
               cmdstr:='--subsystem native';
             app_gui :
               cmdstr:='--subsystem gui';
             app_cui :
               cmdstr:='--subsystem console';
           end;
           if dllversion<>'' then
             cmdstr:=cmdstr+' --version '+dllversion;
           cmdstr:=cmdstr+' --input '+maybequoted(fn);
           cmdstr:=cmdstr+' --stack '+tostr(stacksize);
           DoExec(FindUtil(utilsprefix+'postw32'),cmdstr,false,false);
           postprocessexecutable:=true;
           exit;
         end;
        { open file }
        assign(f,fn);
        {$I-}
         reset(f,1);
        if ioresult<>0 then
          Message1(execinfo_f_cant_open_executable,fn);
        { read headers }
        blockread(f,dosheader,sizeof(tdosheader));
        peheaderpos:=dosheader.e_lfanew;
        { skip to headerpos and skip pe magic }
        seek(f,peheaderpos+4);
        blockread(f,peheader,sizeof(tcoffheader));
        blockread(f,peoptheader,sizeof(tcoffpeoptheader));
        { write info }
        Message1(execinfo_x_codesize,tostr(peoptheader.tsize));
        Message1(execinfo_x_initdatasize,tostr(peoptheader.dsize));
        Message1(execinfo_x_uninitdatasize,tostr(peoptheader.bsize));
        { change stack size (PM) }
        { I am not sure that the default value is adequate !! }
        peoptheader.SizeOfStackReserve:=stacksize;
        if SetPEFlagsSetExplicity then
          peoptheader.LoaderFlags:=peflags;
        if ImageBaseSetExplicity then
          peoptheader.ImageBase:=imagebase;
        if MinStackSizeSetExplicity then
          peoptheader.SizeOfStackCommit:=minstacksize;
        if MaxStackSizeSetExplicity then
          peoptheader.SizeOfStackReserve:=maxstacksize;
        { change the header }
        { sub system }
        { gui=2 }
        { cui=3 }
        { wincegui=9 }
        if target_info.system in [system_arm_wince,system_i386_wince] then
          peoptheader.Subsystem:=9
        else
          case apptype of
            app_native :
              peoptheader.Subsystem:=1;
            app_gui :
              peoptheader.Subsystem:=2;
            app_cui :
              peoptheader.Subsystem:=3;
          end;
        if dllversion<>'' then
          begin
           peoptheader.MajorImageVersion:=dllmajor;
           peoptheader.MinorImageVersion:=dllminor;
          end;
        { reset timestamp }
        peheader.time:=0;
        { write header back, skip pe magic }
        seek(f,peheaderpos+4);
        blockwrite(f,peheader,sizeof(tcoffheader));
        if ioresult<>0 then
          Message1(execinfo_f_cant_process_executable,fn);
        blockwrite(f,peoptheader,sizeof(tcoffpeoptheader));
        if ioresult<>0 then
          Message1(execinfo_f_cant_process_executable,fn);
        { skip to headerpos and skip pe magic }
        seek(f,peheaderpos+4);
        blockread(f,peheader,sizeof(tcoffheader));
        blockread(f,peoptheader,sizeof(tcoffpeoptheader));
        { write the value after the change }
        Message1(execinfo_x_stackreserve,tostr(peoptheader.SizeOfStackReserve));
        Message1(execinfo_x_stackcommit,tostr(peoptheader.SizeOfStackCommit));
        { read section info }
        maxfillsize:=0;
        firstsecpos:=0;
        secroot:=nil;
        for l:=1 to peheader.nsects do
         begin
           blockread(f,coffsec,sizeof(tcoffsechdr));
           if coffsec.datapos>0 then
            begin
              if secroot=nil then
               firstsecpos:=coffsec.datapos;
              new(hsecroot);
              hsecroot^.fillpos:=coffsec.datapos+coffsec.vsize;
              hsecroot^.fillsize:=coffsec.datasize-coffsec.vsize;
              hsecroot^.next:=secroot;
              secroot:=hsecroot;
              if secroot^.fillsize>maxfillsize then
               maxfillsize:=secroot^.fillsize;
            end;
         end;
        if firstsecpos>0 then
         begin
           l:=firstsecpos-filepos(f);
           if l>maxfillsize then
            maxfillsize:=l;
         end
        else
         l:=0;
        { get zero buffer }
        getmem(zerobuf,maxfillsize);
        fillchar(zerobuf^,maxfillsize,0);
        { zero from sectioninfo until first section }
        blockwrite(f,zerobuf^,l);
        { zero section alignments }
        while assigned(secroot) do
         begin
           seek(f,secroot^.fillpos);
           blockwrite(f,zerobuf^,secroot^.fillsize);
           hsecroot:=secroot;
           secroot:=secroot^.next;
           dispose(hsecroot);
         end;
        freemem(zerobuf,maxfillsize);
        close(f);
        {$I+}
        if ioresult<>0 then;
        postprocessexecutable:=true;
      end;


{****************************************************************************
                            TDLLScannerWin
****************************************************************************}

    procedure TDLLScannerWin.CheckDLLFunc(const dllname,funcname:string);
      var
        hp : tExternalsItem;
      begin
        hp:=tExternalsItem(current_module.Externals.first);
        while assigned(hp)do
          begin
            if (not hp.found) and
               assigned(hp.data) and
               (hp.data^=funcname) then
              begin
                hp.found:=true;
                if not(current_module.uses_imports) then
                  begin
                    current_module.uses_imports:=true;
                    importlib.preparelib(current_module.modulename^);
                  end;
                TImportLibWin(importlib).importprocedure_str(dllname,0,funcname);
                importfound:=true;
                exit;
              end;
            hp:=tExternalsItem(hp.next);
          end;
      end;


    function TDLLScannerWin.scan(const binname:string):boolean;
      var
        hs,
        dllname : string;
      begin
        result:=false;
        { is there already an import library the we will use that one }
        if FindLibraryFile(binname,target_info.staticClibprefix,target_info.staticClibext,hs) then
          exit;
        { check if we can find the dll }
        hs:=AddExtension(binname,target_info.sharedlibext);
        if not FindDll(hs,dllname) then
          exit;
        importfound:=false;
        ReadDLLImports(dllname,@CheckDLLFunc);
        result:=importfound;
      end;


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

initialization
{$ifdef i386}
  { Win32 }
  RegisterExternalLinker(system_i386_win32_info,TExternalLinkerWin);
  RegisterInternalLinker(system_i386_win32_info,TInternalLinkerWin);
  RegisterImport(system_i386_win32,TImportLibWin);
  RegisterExport(system_i386_win32,TExportLibWin);
  RegisterDLLScanner(system_i386_win32,TDLLScannerWin);
  RegisterRes(res_gnu_windres_info);
  RegisterTarget(system_i386_win32_info);
  { WinCE }
  RegisterExternalLinker(system_i386_wince_info,TExternalLinkerWin);
  RegisterImport(system_i386_wince,TImportLibWin);
  RegisterExport(system_i386_wince,TExportLibWin);
  RegisterDLLScanner(system_i386_wince,TDLLScannerWin);
  RegisterTarget(system_i386_wince_info);
{$endif i386}
{$ifdef x86_64}
  RegisterInternalLinker(system_x64_win64_info,TInternalLinker);
  RegisterImport(system_x86_64_win64,TImportLibWin);
  RegisterExport(system_x86_64_win64,TExportLibWin);
  RegisterDLLScanner(system_x86_64_win64,TDLLScannerWin);
  RegisterRes(res_gnu_windres_info);
  RegisterTarget(system_x64_win64_info);
{$endif x86_64}
{$ifdef arm}
  RegisterExternalLinker(system_arm_wince_info,TExternalLinkerWin);
  RegisterInternalLinker(system_arm_wince_info,TInternalLinkerWin);
  RegisterImport(system_arm_wince,TImportLibWin);
  RegisterExport(system_arm_wince,TExportLibWin);
  RegisterRes(res_gnu_wince_windres_info);
  RegisterTarget(system_arm_wince_info);
{$endif arm}
end.