paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-08 06:28:06 +02:00
Code Issues Packages Projects Releases Wiki Activity
release_3_2_4-branch
fpc/compiler/systems/t_win.pas
Jonas Maebe 4686f61002 * keep track of the temp position separately from the offset in references, 
so that they can still be freed after the reference has been changed
    (e.g. in case of array indexing or record field accesses) (mantis #33628)

git-svn-id: trunk@38814 -
2018-04-22 17:03:16 +00:00

1859 lines
71 KiB
ObjectPascal
Raw Permalink Blame History

{
Copyright (c) 1998-2008 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
cutils,cclasses,
aasmbase,aasmtai,aasmdata,aasmcpu,fmodule,globtype,globals,systems,verbose,
symconst,symdef,symsym,
cscript,gendef,
cpubase,
import,export,link,comprsrc,i_win;
const
MAX_DEFAULT_EXTENSIONS = 3;
type
tStr4=array[1..MAX_DEFAULT_EXTENSIONS] of string[4];
pStr4=^tStr4;
TImportLibWin=class(timportlib)
private
procedure generateimportlib;
procedure generateidatasection;
public
procedure generatelib;override;
end;
TExportLibWin=class(texportlib)
private
st : string;
EList_indexed:TFPList;
EList_nonindexed:TFPList;
public
destructor Destroy;override;
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;
procedure InitSysInitUnitName;override;
procedure ConcatEntryName; virtual;
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;
procedure InitSysInitUnitName;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
SysUtils,
cfileutl,
cgutils,dbgbase,
owar,ogbase
{$ifdef SUPPORT_OMF}
,ogomf
{$endif SUPPORT_OMF}
,ogcoff;
const
res_gnu_windres_info : tresinfo =
(
id : res_gnu_windres;
resbin : 'fpcres';
rescmd : '-o $OBJ -a $ARCH -of coff $DBG';
rcbin : 'windres';
rccmd : '--include $INC -O res -D FPC -o $RES $RC';
resourcefileclass : nil;
resflags : [];
);
{$ifdef x86_64}
res_win64_gorc_info : tresinfo =
(
id : res_win64_gorc;
resbin : 'fpcres';
rescmd : '-o $OBJ -a $ARCH -of coff $DBG';
rcbin : 'gorc';
rccmd : '/machine x64 /nw /ni /r /d FPC /fo $RES $RC';
resourcefileclass : nil;
resflags : [];
);
{$endif x86_64}
Procedure GlobalInitSysInitUnitName(Linker : TLinker);
var
hp : tmodule;
linkcygwin : boolean;
begin
if target_info.system=system_i386_win32 then
begin
hp:=tmodule(loaded_units.first);
while assigned(hp) do
begin
linkcygwin := hp.linkothersharedlibs.find('cygwin') or hp.linkotherstaticlibs.find('cygwin');
if linkcygwin then
break;
hp:=tmodule(hp.next);
end;
if cs_profile in current_settings.moduleswitches then
linker.sysinitunit:='sysinitgprof'
else if linkcygwin or (Linker.SharedLibFiles.Find('cygwin')<>nil) or (Linker.StaticLibFiles.Find('cygwin')<>nil) then
linker.sysinitunit:='sysinitcyg'
else
linker.sysinitunit:='sysinitpas';
end
else if target_info.system=system_x86_64_win64 then
linker.sysinitunit:='sysinit';
end;
{*****************************************************************************
TImportLibWin
*****************************************************************************}
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:=ExtractFileName(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,mangledname:string;ordnr:longint;isvar:boolean);
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
implabel,
idata2label,
idata5label,
idata6label : TObjSymbol;
emptyint : longint;
objdata : TObjData;
textobjsection,
idata4objsection,
idata5objsection,
idata6objsection,
idata7objsection : TObjSection;
absordnr: word;
procedure WriteTableEntry;
var
ordint: dword;
begin
if ordnr <= 0 then
begin
{ import by name }
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
{ import by ordinal }
ordint:=ordnr;
if target_info.system=system_x86_64_win64 then
begin
objdata.writebytes(ordint,sizeof(ordint));
ordint:=$80000000;
objdata.writebytes(ordint,sizeof(ordint));
end
else
begin
ordint:=ordint or $80000000;
objdata.writebytes(ordint,sizeof(ordint));
end;
end;
end;
begin
implabel:=nil;
idata5label:=nil;
textobjsection:=nil;
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);
absordnr:=Abs(ordnr);
{ write index hint }
objdata.writebytes(absordnr,2);
if ordnr <= 0 then
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);
WriteTableEntry;
{ idata5, import address table }
objdata.SetSection(idata5objsection);
if isvar then
implabel:=objdata.SymbolDefine(mangledname,AB_GLOBAL,AT_DATA)
else
idata5label:=objdata.SymbolDefine(asmprefix+'_'+mangledname,AB_LOCAL,AT_DATA);
WriteTableEntry;
{ text, jmp }
if not isvar then
begin
objdata.SetSection(textobjsection);
if mangledname <> '' then
implabel:=objdata.SymbolDefine(mangledname,AB_GLOBAL,AT_FUNCTION)
else
implabel:=objdata.SymbolDefine(basedllname+'_index_'+tostr(ordnr),AB_GLOBAL,AT_FUNCTION);
objdata.writebytes(jmpopcode,sizeof(jmpopcode));
{$ifdef x86_64}
objdata.writereloc(0,sizeof(longint),idata5label,RELOC_RELATIVE);
{$else}
objdata.writereloc(0,sizeof(longint),idata5label,RELOC_ABSOLUTE32);
{$endif x86_64}
objdata.writebytes(nopopcodes,align(objdata.CurrObjSec.size,qword(sizeof(nopopcodes)))-objdata.CurrObjSec.size);
end;
ObjOutput.exportsymbol(implabel);
WriteObjData(objdata);
objdata.free;
end;
var
i,j : longint;
ImportLibrary : TImportLibrary;
ImportSymbol : TImportSymbol;
begin
AsmPrefix:='imp'+Lower(current_module.modulename^);
idatalabnr:=0;
SmartFilesCount:=0;
SmartHeaderCount:=0;
current_module.linkotherstaticlibs.add(current_module.importlibfilename,link_always);
ObjWriter:=TARObjectWriter.CreateAr(current_module.importlibfilename);
ObjOutput:=TPECoffObjOutput.Create(ObjWriter);
for i:=0 to current_module.ImportLibraryList.Count-1 do
begin
ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]);
StartImport(ImportLibrary.Name);
for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do
begin
ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
AddImport(ImportSymbol.Name,ImportSymbol.MangledName,ImportSymbol.OrdNr,ImportSymbol.IsVar);
end;
EndImport;
end;
ObjOutput.Free;
ObjWriter.Free;
end;
procedure TImportLibWin.generateidatasection;
var
templab,
l1,l2,l3,l4 {$ifdef ARM} ,l5 {$endif ARM} : tasmlabel;
importname : string;
suffix : integer;
href : treference;
i,j : longint;
ImportLibrary : TImportLibrary;
ImportSymbol : TImportSymbol;
ImportLabels : TFPList;
begin
if current_asmdata.asmlists[al_imports]=nil then
current_asmdata.asmlists[al_imports]:=TAsmList.create;
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);
for i:=0 to current_module.ImportLibraryList.Count-1 do
begin
ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]);
for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do
begin
ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_extern,ImportSymbol.Name));
current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_nasm_import,ImportSymbol.Name+' '+ImportLibrary.Name+' '+ImportSymbol.Name));
end;
end;
exit;
end;
for i:=0 to current_module.ImportLibraryList.Count-1 do
begin
ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]);
{ 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));
ImportLabels:=TFPList.Create;
ImportLabels.Count:=ImportLibrary.ImportSymbolList.Count;
for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do
begin
ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
current_asmdata.getjumplabel(templab);
ImportLabels[j]:=templab;
if ImportSymbol.Name<>'' then
begin
current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(TAsmLabel(ImportLabels[j])));
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 ImportSymbol.ordnr))
else
current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(longint($80000000) or ImportSymbol.ordnr));
end;
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));
for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do
begin
ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
if not ImportSymbol.IsVar 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 ImportSymbol.Name <> '' then
current_asmdata.asmlists[al_imports].concat(Tai_symbol.Createname_global(ImportSymbol.MangledName,AT_FUNCTION,0,voidcodepointertype))
else
current_asmdata.asmlists[al_imports].concat(Tai_symbol.Createname_global(ExtractFileName(ImportLibrary.Name)+'_index_'+tostr(ImportSymbol.ordnr),AT_FUNCTION,0,voidcodepointertype));
current_asmdata.asmlists[al_imports].concat(tai_function_name.create(''));
{$ifdef ARM}
reference_reset_symbol(href,l5,0,sizeof(pint),[]);
current_asmdata.asmlists[al_imports].concat(Taicpu.op_reg_ref(A_LDR,NR_R12,href));
reference_reset_base(href,NR_R12,0,ctempposinvalid,sizeof(pint),[]);
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,sizeof(pint),[]);
current_asmdata.asmlists[al_imports].concat(tai_const.create_sym_offset(href.symbol,href.offset));
{$else ARM}
reference_reset_symbol(href,l4,0,sizeof(pint),[]);
{$ifdef X86_64}
href.base:=NR_RIP;
{$endif X86_64}
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 current_settings.moduleswitches) then
begin
if ImportSymbol.MangledName<>'' then
begin
importname:='__imp_'+ImportSymbol.MangledName;
suffix:=0;
while assigned(current_asmdata.getasmsymbol(importname)) do
begin
inc(suffix);
importname:='__imp_'+ImportSymbol.MangledName+'_'+tostr(suffix);
end;
current_asmdata.asmlists[al_imports].concat(tai_symbol.createname(importname,AT_FUNCTION,4,voidcodepointertype));
end
else
begin
importname:='__imp_by_ordinal'+tostr(ImportSymbol.ordnr);
suffix:=0;
while assigned(current_asmdata.getasmsymbol(importname)) do
begin
inc(suffix);
importname:='__imp_by_ordinal'+tostr(ImportSymbol.ordnr)+'_'+tostr(suffix);
end;
current_asmdata.asmlists[al_imports].concat(tai_symbol.createname(importname,AT_FUNCTION,4,voidcodepointertype));
end;
end;
current_asmdata.asmlists[al_imports].concat(Tai_label.Create(l4));
end
else
current_asmdata.asmlists[al_imports].concat(Tai_symbol.Createname_global(ImportSymbol.MangledName,AT_DATA,0,voidpointertype));
current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(TAsmLabel(Importlabels[j])));
if target_info.system=system_x86_64_win64 then
current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));
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);
for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do
begin
ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
current_asmdata.asmlists[al_imports].concat(Tai_label.Create(TAsmLabel(ImportLabels[j])));
{ the ordinal number }
current_asmdata.asmlists[al_imports].concat(Tai_const.Create_16bit(ImportSymbol.ordnr));
current_asmdata.asmlists[al_imports].concat(Tai_string.Create(ImportSymbol.Name+#0));
current_asmdata.asmlists[al_imports].concat(Tai_align.Create_op(2,0));
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(ImportLibrary.Name+#0));
ImportLabels.Free;
ImportLabels:=nil;
end;
end;
procedure TImportLibWin.generatelib;
begin
if GenerateImportSection then
generateidatasection
else
generateimportlib;
end;
{*****************************************************************************
TExportLibWin
*****************************************************************************}
destructor TExportLibWin.Destroy;
begin
EList_indexed.Free;
EList_nonindexed.Free;
inherited;
end;
procedure TExportLibWin.preparelib(const s:string);
begin
if current_asmdata.asmlists[al_exports]=nil then
current_asmdata.asmlists[al_exports]:=TAsmList.create;
if EList_indexed=nil then
EList_indexed:=tFPList.Create;
if EList_nonindexed=nil then
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 (eo_index in hp.options) and ((hp.index<=0) or (hp.index>$ffff)) then
begin
message1(parser_e_export_invalid_index,tostr(hp.index));
exit;
end;
if eo_index in hp.options 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 !! }
duplicatesymbol(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;
asmsym : TAsmSymbol;
begin
Gl_DoubleIndex:=false;
ELIst_indexed.Sort(@IdxCompare);
if Gl_DoubleIndex then
begin
message1(parser_e_export_ordinal_double,tostr(Gl_DoubleIndexValue));
FreeAndNil(EList_indexed);
FreeAndNil(EList_nonindexed);
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;
FreeAndNil(EList_nonindexed);
for i:=0 to pred(EList_indexed.Count) do
exportfromlist(texported_item(EList_indexed.Items[i]));
FreeAndNil(EList_indexed);
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_METADATA,0,voidpointertype));
{ 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 eo_name in hp.options 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;
{ symbol known? then get a new name }
if assigned(hp.sym) and not (eo_no_sym_name in hp.options) then
case hp.sym.typ of
staticvarsym :
asmsym:=current_asmdata.RefAsmSymbol(tstaticvarsym(hp.sym).mangledname,AT_DATA);
procsym :
asmsym:=current_asmdata.RefAsmSymbol(tprocdef(tprocsym(hp.sym).ProcdefList[0]).mangledname,AT_FUNCTION)
else
internalerror(200709272);
end
else
asmsym:=current_asmdata.RefAsmSymbol(hp.name^,AT_DATA);
address_table.concat(Tai_const.Create_rva_sym(asmsym));
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;
{ the package support needs this data later on
to create the import library }
current_module._exports.concatlist(temtexport);
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
staticvarsym :
s:=tstaticvarsym(hp.sym).mangledname;
procsym :
s:=tprocdef(tprocsym(hp.sym).ProcdefList[0]).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;
CArObjectReader:=TArObjectReader;
CExeoutput:=TPECoffexeoutput;
CObjInput:=TPECoffObjInput;
end;
procedure TInternalLinkerWin.DefaultLinkScript;
begin
ScriptAddSourceStatements(true);
with LinkScript do
begin
if IsSharedLibrary then
Concat('ISSHAREDLIBRARY');
ConcatEntryName;
if not ImageBaseSetExplicity then
begin
if IsSharedLibrary then
imagebase:={$ifdef cpu64bitaddr} $110000000 {$else} $10000000 {$endif}
else
if target_info.system in systems_wince then
imagebase:=$10000
else
{$ifdef cpu64bitaddr}
if (target_dbg.id = dbg_stabs) then
imagebase:=$400000
else
imagebase:= $100000000;
{$else}
imagebase:=$400000;
{$endif}
end;
Concat('IMAGEBASE $' + hexStr(imagebase, SizeOf(imagebase)*2));
Concat('HEADER');
Concat('EXESECTION .text');
Concat(' SYMBOL __text_start__');
Concat(' OBJSECTION .text*');
Concat(' SYMBOL ___CTOR_LIST__');
Concat(' SYMBOL __CTOR_LIST__');
Concat(' LONG -1');
{$ifdef x86_64}
Concat(' LONG -1');
{$endif x86_64}
Concat(' OBJSECTION .ctor*');
Concat(' LONG 0');
{$ifdef x86_64}
Concat(' LONG 0');
{$endif x86_64}
Concat(' SYMBOL ___DTOR_LIST__');
Concat(' SYMBOL __DTOR_LIST__');
Concat(' LONG -1');
{$ifdef x86_64}
Concat(' LONG -1');
{$endif x86_64}
Concat(' OBJSECTION .dtor*');
Concat(' LONG 0');
{$ifdef x86_64}
Concat(' LONG 0');
{$endif x86_64}
Concat(' SYMBOL etext');
Concat('ENDEXESECTION');
Concat('EXESECTION .data');
Concat(' SYMBOL __data_start__');
Concat(' OBJSECTION .data*');
Concat(' OBJSECTION .fpc*');
Concat(' PROVIDE '+target_info.Cprefix+'_tls_index');
Concat(' LONG 0');
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(' OBJSECTION .xdata*');
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 .tls');
Concat(' SYMBOL ___tls_start__');
Concat(' OBJSECTION .tls*');
Concat(' SYMBOL ___tls_end__');
Concat('ENDEXESECTION');
Concat('EXESECTION .CRT');
Concat(' SYMBOL ___crt_xc_start__');
Concat(' OBJSECTION .CRT$XC*');{ /* C initialization */');}
Concat(' SYMBOL ___crt_xc_end__');
Concat(' SYMBOL ___crt_xi_start__');
Concat(' OBJSECTION .CRT$XI*');{ /* C++ initialization */');}
Concat(' SYMBOL ___crt_xi_end__');
Concat(' SYMBOL ___crt_xl_start__');
Concat(' OBJSECTION .CRT$XL*'); { /* TLS callbacks */'); }
{ In GNU ld, this is defined in the TLS Directory support code }
Concat(' PROVIDE ___crt_xl_end__');
{ Add a nil pointer as last element }
Concat(' LONG 0');
{$ifdef x86_64}
Concat(' LONG 0');
{$endif x86_64}
Concat(' SYMBOL ___crt_xp_start__');
Concat(' OBJSECTION .CRT$XP*'); { /* Pre-termination */');}
Concat(' SYMBOL ___crt_xp_end__');
Concat(' SYMBOL ___crt_xt_start__');
Concat(' OBJSECTION .CRT$XT*');{ /* Termination */');}
Concat(' SYMBOL ___crt_xt_end__');
Concat('ENDEXESECTION');
Concat('EXESECTION .idata');
Concat(' OBJSECTION .idata$2*');
Concat(' OBJSECTION .idata$3*');
Concat(' ZEROS 20');
Concat(' OBJSECTION .idata$4*');
Concat(' SYMBOL __IAT_start__');
Concat(' OBJSECTION .idata$5*');
Concat(' SYMBOL __IAT_end__');
Concat(' OBJSECTION .idata$6*');
Concat(' OBJSECTION .idata$7*');
Concat('ENDEXESECTION');
ScriptAddGenericSections('.edata,.rsrc,.reloc,.gnu_debuglink,'+
'.debug_aranges,.debug_pubnames,.debug_info,.debug_abbrev,.debug_line,.debug_frame,.debug_str,.debug_loc,'+
'.debug_macinfo,.debug_weaknames,.debug_funcnames,.debug_typenames,.debug_varnames,.debug_ranges');
{ Can't use the generic rules, because that will add also .stabstr to .stab }
Concat('EXESECTION .stab');
Concat(' OBJSECTION .stab');
Concat('ENDEXESECTION');
Concat('EXESECTION .stabstr');
Concat(' OBJSECTION .stabstr');
Concat('ENDEXESECTION');
Concat('STABS');
Concat('SYMBOLS');
end;
end;
procedure TInternalLinkerWin.InitSysInitUnitName;
begin
GlobalInitSysInitUnitName(self)
end;
procedure TInternalLinkerWin.ConcatEntryName;
begin
with LinkScript do
begin
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;
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
{$ifdef x86_64}
targetopts:='-b pei-x86-64';
{$else x86_64}
if target_info.system=system_arm_wince then
targetopts:='-m arm_wince_pe'
else
targetopts:='-b pei-i386 -m i386pe';
{$endif not x86_64}
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 : TCmdStrListItem;
s,s2 : TCmdStr;
i : integer;
begin
WriteResponseFile:=False;
if (cs_profile in current_settings.moduleswitches) 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,true);
with linkres do
begin
{ Write path to search libraries }
HPath:=TCmdStrListItem(current_module.locallibrarysearchpath.First);
while assigned(HPath) do
begin
Add('SEARCH_DIR("'+HPath.Str+'")');
HPath:=TCmdStrListItem(HPath.Next);
end;
HPath:=TCmdStrListItem(LibrarySearchPath.First);
while assigned(HPath) do
begin
Add('SEARCH_DIR("'+HPath.Str+'")');
HPath:=TCmdStrListItem(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");');
{$ifdef x86_64}
Add('OUTPUT_FORMAT(pei-x86-64)');
{$else not 86_64}
Add('OUTPUT_FORMAT(pei-i386)');
{$endif not x86_64}
Add('ENTRY(_mainCRTStartup)');
Add('SECTIONS');
Add('{');
Add(' . = SIZEOF_HEADERS;');
Add(' . = ALIGN(__section_alignment__);');
Add(' .text __image_base__ + ( __section_alignment__ < 0x1000 ? . : __section_alignment__ ) :');
Add(' {');
Add(' __text_start__ = . ;');
Add(' *(.init)');
add(' *(.text .stub .text.* .gnu.linkonce.t.*)');
Add(' *(SORT(.text$*))');
Add(' *(.glue_7t)');
Add(' *(.glue_7)');
Add(' . = ALIGN(8);');
Add(' ___CTOR_LIST__ = .; __CTOR_LIST__ = . ;');
Add(' LONG (-1);');
{$ifdef x86_64}
Add(' LONG (-1);');
{$endif x86_64}
Add(' *(.ctors); *(.ctor); *(SORT(.ctors.*)); LONG (0);');
{$ifdef x86_64}
Add(' LONG (0);');
{$endif x86_64}
Add(' ___DTOR_LIST__ = .; __DTOR_LIST__ = . ;');
Add(' LONG (-1);');
{$ifdef x86_64}
Add(' LONG (-1);');
{$endif x86_64}
Add(' *(.dtors); *(.dtor); *(SORT(.dtors.*)); LONG (0);');
{$ifdef x86_64}
Add(' LONG (0);');
{$endif x86_64}
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.* .fpc*)');
Add(' *(.data2)');
Add(' *(SORT(.data$*))');
Add(' *(.jcr)');
Add(' PROVIDE ('+target_info.Cprefix+'_tls_index = .);');
Add(' LONG (0);');
Add(' __data_end__ = . ;');
Add(' *(.data_cygwin_nocopy)');
Add(' }');
Add(' .rdata BLOCK(__section_alignment__) :');
Add(' {');
Add(' *(.rdata)');
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(' PROVIDE (___crt_xl_end__ = .);');
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,
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 current_settings.globalswitches) 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 create_smartlink_sections then
GCSectionsStr:='--gc-sections';
if target_info.system in systems_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 ImageBaseSetExplicity then
ImageBaseStr:='--image-base=0x'+hexStr(imagebase, SizeOf(imagebase)*2);
if (cs_link_strip in current_settings.globalswitches) then
StripStr:='-s';
if (cs_link_map in current_settings.globalswitches) then
MapStr:='-Map '+maybequoted(ChangeFileExt(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 current_settings.globalswitches) then
begin
DeleteFile(outputexedir+Info.ResName);
DeleteFile('base.$$$');
DeleteFile('exp.$$$');
DeleteFile('deffile.$$$');
end;
MakeExecutable:=success; { otherwise a recursive call to link method }
end;
Function TExternalLinkerWin.MakeSharedLibrary:boolean;
var
MapStr,
binstr,
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 current_settings.globalswitches) 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 create_smartlink_sections then
GCSectionsStr:='--gc-sections';
if apptype=app_gui then
begin
AppTypeStr:='--subsystem windows';
EntryStr:='--entry _DLLWinMainCRTStartup'
end
else
EntryStr:='--entry _DLLMainCRTStartup';
if ImageBaseSetExplicity then
ImageBaseStr:='--image-base=0x'+hexStr(imagebase, SizeOf(imagebase)*2);
if (cs_link_strip in current_settings.globalswitches) then
StripStr:='-s';
if (cs_link_map in current_settings.globalswitches) then
MapStr:='-Map '+maybequoted(ChangeFileExt(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 current_settings.globalswitches) then
begin
DeleteFile(outputexedir+Info.ResName);
DeleteFile('base.$$$');
DeleteFile('exp.$$$');
DeleteFile('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 current_settings.globalswitches) 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);
if target_info.system in [system_i386_win32, system_i386_wdosx] then
DoExec(FindUtil(utilsprefix+'postw32'),cmdstr,false,false);
postprocessexecutable:=true;
exit;
end;
{ open file }
assign(f,fn);
{$push}{$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 systems_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);
{$pop}
if ioresult<>0 then;
postprocessexecutable:=true;
end;
procedure TExternalLinkerWin.InitSysInitUnitName;
begin
GlobalInitSysInitUnitName(self);
end;
{****************************************************************************
TDLLScannerWin
****************************************************************************}
procedure TDLLScannerWin.CheckDLLFunc(const dllname,funcname:string);
var
i : longint;
ExtName : string;
begin
for i:=0 to current_module.dllscannerinputlist.count-1 do
begin
ExtName:=current_module.dllscannerinputlist.NameOfIndex(i);
if (ExtName=funcname) then
begin
current_module.AddExternalImport(dllname,funcname,funcname,0,false,false);
importfound:=true;
current_module.dllscannerinputlist.Delete(i);
exit;
end;
end;
end;
function TDLLScannerWin.scan(const binname:string):boolean;
var
hs,
dllname : TCmdStr;
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:=binname;
if ExtractFileExt(hs)='' then
hs:=ChangeFileExt(hs,target_info.sharedlibext);
if not FindDll(hs,dllname) then
exit;
importfound:=false;
ReadDLLImports(dllname,@CheckDLLFunc);
if importfound then
current_module.dllscannerinputlist.Pack;
result:=importfound;
end;
{*****************************************************************************
Initialize
*****************************************************************************}
initialization
RegisterLinker(ld_int_windows,TInternalLinkerWin);
RegisterLinker(ld_windows,TExternalLinkerWin);
{$ifdef i386}
{ Win32 }
RegisterImport(system_i386_win32,TImportLibWin);
RegisterExport(system_i386_win32,TExportLibWin);
RegisterDLLScanner(system_i386_win32,TDLLScannerWin);
RegisterRes(res_gnu_windres_info,TWinLikeResourceFile);
RegisterTarget(system_i386_win32_info);
{ WinCE }
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}
RegisterImport(system_x86_64_win64,TImportLibWin);
RegisterExport(system_x86_64_win64,TExportLibWin);
RegisterDLLScanner(system_x86_64_win64,TDLLScannerWin);
RegisterRes(res_gnu_windres_info,TWinLikeResourceFile);
RegisterRes(res_win64_gorc_info,TWinLikeResourceFile);
RegisterTarget(system_x64_win64_info);
{$endif x86_64}
{$ifdef arm}
RegisterImport(system_arm_wince,TImportLibWin);
RegisterExport(system_arm_wince,TExportLibWin);
RegisterRes(res_gnu_windres_info,TWinLikeResourceFile);
RegisterTarget(system_arm_wince_info);
{$endif arm}
end.
Reference in New Issue View Git Blame Copy Permalink