123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091 |
- {
- Copyright (c) 1998-2002 by Peter Vreman
- This unit handles the linker and binder calls for programs and
- libraries
- 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 link;
- {$i fpcdefs.inc}
- interface
- uses
- sysutils,
- cclasses,
- systems,
- fmodule,
- globtype,
- ldscript,
- ogbase,
- owbase;
- Type
- TLinkerInfo=record
- ExeCmd,
- DllCmd,
- ExtDbgCmd : array[1..3] of ansistring;
- ResName : string[100];
- ScriptName : string[100];
- ExtraOptions : TCmdStr;
- DynamicLinker : string[100];
- end;
- TLinker = class(TObject)
- public
- HasResources,
- HasExports : boolean;
- SysInitUnit : string[20];
- ObjectFiles,
- SharedLibFiles,
- StaticLibFiles,
- FrameworkFiles,
- OrderedSymbols: TCmdStrList;
- Constructor Create;virtual;
- Destructor Destroy;override;
- procedure AddModuleFiles(hp:tmodule);
- Procedure AddObject(const S,unitpath : TPathStr;isunit:boolean);
- Procedure AddStaticLibrary(const S : TCmdStr);
- Procedure AddSharedLibrary(S : TCmdStr);
- Procedure AddStaticCLibrary(const S : TCmdStr);
- Procedure AddSharedCLibrary(S : TCmdStr);
- Procedure AddFramework(S : TCmdStr);
- Procedure AddOrderedSymbol(const s: TCmdStr);
- procedure AddImportSymbol(const libname,symname,symmangledname:TCmdStr;OrdNr: longint;isvar:boolean);virtual;
- Procedure InitSysInitUnitName;virtual;
- Function MakeExecutable:boolean;virtual;
- Function MakeSharedLibrary:boolean;virtual;
- Function MakeStaticLibrary:boolean;virtual;
- procedure ExpandAndApplyOrder(var Src:TCmdStrList);
- procedure LoadPredefinedLibraryOrder;virtual;
- function ReOrderEntries : boolean;
- end;
- TExternalLinker = class(TLinker)
- protected
- Function WriteSymbolOrderFile: TCmdStr;
- public
- Info : TLinkerInfo;
- Constructor Create;override;
- Destructor Destroy;override;
- Function FindUtil(const s:TCmdStr):TCmdStr;
- Function CatFileContent(para:TCmdStr):TCmdStr;
- Function DoExec(const command:TCmdStr; para:TCmdStr;showinfo,useshell:boolean):boolean;
- procedure SetDefaultInfo;virtual;
- Function MakeStaticLibrary:boolean;override;
- Function UniqueName(const str:TCmdStr): TCmdStr;
- function PostProcessELFExecutable(const fn: string; isdll: boolean): boolean;
- end;
- TBooleanArray = array [1..1024] of boolean;
- PBooleanArray = ^TBooleanArray;
- TInternalLinker = class(TLinker)
- private
- FCExeOutput : TExeOutputClass;
- FCObjInput : TObjInputClass;
- FCArObjectReader : TObjectReaderClass;
- { Libraries }
- FStaticLibraryList : TFPObjectList;
- FImportLibraryList : TFPHashObjectList;
- FGroupStack : TFPObjectList;
- procedure Load_ReadObject(const para:TCmdStr);
- procedure Load_ReadStaticLibrary(const para:TCmdStr;asneededflag:boolean=false);
- procedure Load_Group;
- procedure Load_EndGroup;
- procedure ParseScript_Handle;
- procedure ParseScript_PostCheck;
- procedure ParseScript_Load;
- function ParsePara(const para : string) : string;
- procedure ParseScript_Order;
- procedure ParseScript_MemPos;
- procedure ParseScript_DataPos;
- procedure PrintLinkerScript;
- function RunLinkScript(const outputname:TCmdStr):boolean;
- procedure ParseLdScript(src:TScriptLexer);
- protected
- linkscript : TCmdStrList;
- ScriptCount : longint;
- IsHandled : PBooleanArray;
- property CArObjectReader:TObjectReaderClass read FCArObjectReader write FCArObjectReader;
- property CObjInput:TObjInputClass read FCObjInput write FCObjInput;
- property CExeOutput:TExeOutputClass read FCExeOutput write FCExeOutput;
- property StaticLibraryList:TFPObjectList read FStaticLibraryList;
- property ImportLibraryList:TFPHashObjectList read FImportLibraryList;
- procedure DefaultLinkScript;virtual;abstract;
- procedure ScriptAddGenericSections(secnames:string);
- procedure ScriptAddSourceStatements(AddSharedAsStatic:boolean);virtual;
- function GetCodeSize(aExeOutput: TExeOutput): QWord;virtual;
- function GetDataSize(aExeOutput: TExeOutput): QWord;virtual;
- function GetBssSize(aExeOutput: TExeOutput): QWord;virtual;
- function ExecutableFilename:String;virtual;
- function SharedLibFilename:String;virtual;
- public
- IsSharedLibrary : boolean;
- UseStabs : boolean;
- Constructor Create;override;
- Destructor Destroy;override;
- Function MakeExecutable:boolean;override;
- Function MakeSharedLibrary:boolean;override;
- procedure AddImportSymbol(const libname,symname,symmangledname:TCmdStr;OrdNr: longint;isvar:boolean);override;
- end;
- TLinkerClass = class of Tlinker;
- var
- Linker : TLinker;
- function FindObjectFile(s : TCmdStr;const unitpath:TCmdStr;isunit:boolean) : TCmdStr;
- function FindLibraryFile(s:TCmdStr;const prefix,ext:TCmdStr;var foundfile : TCmdStr) : boolean;
- function FindDLL(const s:TCmdStr;var founddll:TCmdStr):boolean;
- procedure RegisterLinker(id:tlink;c:TLinkerClass);
- procedure InitLinker;
- procedure DoneLinker;
- Implementation
- uses
- cutils,cfileutl,cstreams,
- {$ifdef hasUnix}
- baseunix,
- {$endif hasUnix}
- cscript,globals,verbose,comphook,ppu,fpccrc,
- aasmbase,aasmcpu,
- ogmap;
- var
- CLinker : array[tlink] of TLinkerClass;
- {*****************************************************************************
- Helpers
- *****************************************************************************}
- function GetFileCRC(const fn:TPathStr):cardinal;
- var
- fs : TCStream;
- bufcount,
- bufsize : Integer;
- buf : pbyte;
- begin
- result:=0;
- bufsize:=64*1024;
- fs:=CFileStreamClass.Create(fn,fmOpenRead or fmShareDenyNone);
- if CStreamError<>0 then
- begin
- fs.Free;
- Comment(V_Error,'Can''t open file: '+fn);
- exit;
- end;
- getmem(buf,bufsize);
- repeat
- bufcount:=fs.Read(buf^,bufsize);
- result:=UpdateCrc32(result,buf^,bufcount);
- until bufcount<bufsize;
- freemem(buf);
- fs.Free;
- end;
- { searches an object file }
- function FindObjectFile(s:TCmdStr;const unitpath:TCmdStr;isunit:boolean) : TCmdStr;
- var
- found : boolean;
- foundfile : TCmdStr;
- begin
- findobjectfile:='';
- if s='' then
- exit;
- {When linking on target, the units has not been assembled yet,
- if assembling is also done on target,
- so there is no object files to look for at
- the host. Look for the corresponding assembler file instead,
- because it will be assembled to object file on the target.}
- if isunit and (cs_assemble_on_target in current_settings.globalswitches) then
- s:=ChangeFileExt(s,target_info.asmext);
- { when it does not belong to the unit then check if
- the specified file exists without searching any paths }
- if not isunit then
- begin
- if FileExists(FixFileName(s),false) then
- begin
- foundfile:=ScriptFixFileName(s);
- found:=true;
- end;
- end;
- if pos('.',s)=0 then
- s:=s+target_info.objext;
- { find object file
- 1. output unit path
- 2. output exe path
- 3. specified unit path (if specified)
- 4. cwd
- 5. unit search path
- 6. local object path
- 7. global object path
- 8. exepath (not when linking on target)
- for all finds don't use the directory caching }
- found:=false;
- if isunit and (OutputUnitDir<>'') then
- found:=FindFile(s,OutPutUnitDir,false,foundfile)
- else
- if OutputExeDir<>'' then
- found:=FindFile(s,OutPutExeDir,false,foundfile);
- if (not found) and (unitpath<>'') then
- found:=FindFile(s,unitpath,false,foundfile);
- if (not found) then
- found:=FindFile(s, CurDirRelPath(source_info),false,foundfile);
- if (not found) then
- found:=UnitSearchPath.FindFile(s,false,foundfile);
- if (not found) then
- found:=current_module.localobjectsearchpath.FindFile(s,false,foundfile);
- if (not found) then
- found:=objectsearchpath.FindFile(s,false,foundfile);
- if not(cs_link_on_target in current_settings.globalswitches) and (not found) then
- found:=FindFile(s,exepath,false,foundfile);
- if not(cs_link_nolink in current_settings.globalswitches) and (not found) then
- Message1(exec_w_objfile_not_found,s);
- {Restore file extension}
- if isunit and (cs_assemble_on_target in current_settings.globalswitches) then
- foundfile:= ChangeFileExt(foundfile,target_info.objext);
- findobjectfile:=ScriptFixFileName(foundfile);
- end;
- { searches a (windows) DLL file }
- function FindDLL(const s:TCmdStr;var founddll:TCmdStr):boolean;
- var
- sysdir : TCmdStr;
- Found : boolean;
- begin
- Found:=false;
- { Look for DLL in:
- 1. Current dir
- 2. Library Path
- 3. windir,windir/system,windir/system32 }
- Found:=FindFile(s,'.'+source_info.DirSep,false,founddll);
- if (not found) then
- Found:=librarysearchpath.FindFile(s,false,founddll);
- { when cross compiling, it is pretty useless to search windir etc. for dlls }
- if (not found) and (source_info.system=target_info.system) then
- begin
- sysdir:=FixPath(GetEnvironmentVariable('windir'),false);
- Found:=FindFile(s,sysdir+';'+sysdir+'system'+source_info.DirSep+';'+sysdir+'system32'+source_info.DirSep,false,founddll);
- end;
- if (not found) then
- begin
- message1(exec_w_libfile_not_found,s);
- FoundDll:=s;
- end;
- FindDll:=Found;
- end;
- { searches an library file }
- function FindLibraryFile(s:TCmdStr;const prefix,ext:TCmdStr;var foundfile : TCmdStr) : boolean;
- var
- found : boolean;
- paths : TCmdStr;
- begin
- findlibraryfile:=false;
- foundfile:=s;
- if s='' then
- exit;
- { split path from filename }
- paths:=ExtractFilePath(s);
- s:=ExtractFileName(s);
- { add prefix 'lib' }
- if (prefix<>'') and (Copy(s,1,length(prefix))<>prefix) then
- s:=prefix+s;
- { add extension }
- if (ext<>'') and (Copy(s,length(s)-length(ext)+1,length(ext))<>ext) then
- s:=s+ext;
- { readd the split path }
- s:=paths+s;
- if FileExists(s,false) then
- begin
- foundfile:=ScriptFixFileName(s);
- FindLibraryFile:=true;
- exit;
- end;
- { find libary
- 1. cwd
- 2. local libary dir
- 3. global libary dir
- 4. exe path of the compiler (not when linking on target)
- for all searches don't use the directory cache }
- found:=FindFile(s, CurDirRelPath(source_info), false,foundfile);
- if (not found) and (current_module.outputpath<>'') then
- found:=FindFile(s,current_module.outputpath,false,foundfile);
- if (not found) then
- found:=current_module.locallibrarysearchpath.FindFile(s,false,foundfile);
- if (not found) then
- found:=librarysearchpath.FindFile(s,false,foundfile);
- if not(cs_link_on_target in current_settings.globalswitches) and (not found) then
- found:=FindFile(s,exepath,false,foundfile);
- foundfile:=ScriptFixFileName(foundfile);
- findlibraryfile:=found;
- end;
- {*****************************************************************************
- TLINKER
- *****************************************************************************}
- Constructor TLinker.Create;
- begin
- Inherited Create;
- ObjectFiles:=TCmdStrList.Create_no_double;
- SharedLibFiles:=TCmdStrList.Create_no_double;
- StaticLibFiles:=TCmdStrList.Create_no_double;
- FrameworkFiles:=TCmdStrList.Create_no_double;
- OrderedSymbols:=TCmdStrList.Create;
- end;
- Destructor TLinker.Destroy;
- begin
- ObjectFiles.Free;
- SharedLibFiles.Free;
- StaticLibFiles.Free;
- FrameworkFiles.Free;
- OrderedSymbols.Free;
- inherited;
- end;
- procedure TLinker.AddModuleFiles(hp:tmodule);
- var
- mask : longint;
- i,j : longint;
- ImportLibrary : TImportLibrary;
- ImportSymbol : TImportSymbol;
- begin
- with hp do
- begin
- if mf_has_resourcefiles in moduleflags then
- HasResources:=true;
- if mf_has_exports in moduleflags then
- HasExports:=true;
- { link unit files }
- if (headerflags and uf_no_link)=0 then
- begin
- { create mask which unit files need linking }
- mask:=link_always;
- { lto linking ?}
- if (cs_lto in current_settings.moduleswitches) and
- ((headerflags and uf_lto_linked)<>0) and
- (not(cs_lto_nosystem in init_settings.globalswitches) or
- (hp.modulename^<>'SYSTEM')) then
- begin
- mask:=mask or link_lto;
- end
- else
- begin
- { static linking ? }
- if (cs_link_static in current_settings.globalswitches) then
- begin
- if (headerflags and uf_static_linked)=0 then
- begin
- { if static not avail then try smart linking }
- if (headerflags and uf_smart_linked)<>0 then
- begin
- Message1(exec_t_unit_not_static_linkable_switch_to_smart,modulename^);
- mask:=mask or link_smart;
- end
- else
- Message1(exec_e_unit_not_smart_or_static_linkable,modulename^);
- end
- else
- mask:=mask or link_static;
- end;
- { smart linking ? }
- if (cs_link_smart in current_settings.globalswitches) then
- begin
- if (headerflags and uf_smart_linked)=0 then
- begin
- { if smart not avail then try static linking }
- if (headerflags and uf_static_linked)<>0 then
- begin
- { if not create_smartlink_library, then smart linking happens using the
- regular object files
- }
- if create_smartlink_library then
- Message1(exec_t_unit_not_smart_linkable_switch_to_static,modulename^);
- mask:=mask or link_static;
- end
- else
- Message1(exec_e_unit_not_smart_or_static_linkable,modulename^);
- end
- else
- mask:=mask or link_smart;
- end;
- { shared linking }
- if (cs_link_shared in current_settings.globalswitches) then
- begin
- if (headerflags and uf_shared_linked)=0 then
- begin
- { if shared not avail then try static linking }
- if (headerflags and uf_static_linked)<>0 then
- begin
- Message1(exec_t_unit_not_shared_linkable_switch_to_static,modulename^);
- mask:=mask or link_static;
- end
- else
- Message1(exec_e_unit_not_shared_or_static_linkable,modulename^);
- end
- else
- mask:=mask or link_shared;
- end;
- end;
- { unit files }
- while not linkunitofiles.empty do
- AddObject(linkunitofiles.getusemask(mask),path,true);
- while not linkunitstaticlibs.empty do
- AddStaticLibrary(linkunitstaticlibs.getusemask(mask));
- while not linkunitsharedlibs.empty do
- AddSharedLibrary(linkunitsharedlibs.getusemask(mask));
- end;
- { Other needed .o and libs, specified using $L,$LINKLIB,external }
- mask:=link_always;
- while not linkotherofiles.empty do
- AddObject(linkotherofiles.Getusemask(mask),path,false);
- while not linkotherstaticlibs.empty do
- AddStaticCLibrary(linkotherstaticlibs.Getusemask(mask));
- while not linkothersharedlibs.empty do
- AddSharedCLibrary(linkothersharedlibs.Getusemask(mask));
- while not linkotherframeworks.empty do
- AddFramework(linkotherframeworks.Getusemask(mask));
- { Known Library/DLL Imports }
- for i:=0 to ImportLibraryList.Count-1 do
- begin
- ImportLibrary:=TImportLibrary(ImportLibraryList[i]);
- for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do
- begin
- ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
- AddImportSymbol(ImportLibrary.Name,ImportSymbol.Name,
- ImportSymbol.MangledName,ImportSymbol.OrdNr,ImportSymbol.IsVar);
- end;
- end;
- { ordered symbols }
- OrderedSymbols.concatList(linkorderedsymbols);
- end;
- end;
- procedure TLinker.AddImportSymbol(const libname,symname,symmangledname:TCmdStr;OrdNr: longint;isvar:boolean);
- begin
- end;
- Procedure TLinker.AddObject(const S,unitpath : TPathStr;isunit:boolean);
- begin
- ObjectFiles.Concat(FindObjectFile(s,unitpath,isunit))
- end;
- Procedure TLinker.AddSharedLibrary(S:TCmdStr);
- begin
- if s='' then
- exit;
- { remove prefix 'lib' }
- if Copy(s,1,length(target_info.sharedlibprefix))=target_info.sharedlibprefix then
- Delete(s,1,length(target_info.sharedlibprefix));
- { remove extension if any }
- if Copy(s,length(s)-length(target_info.sharedlibext)+1,length(target_info.sharedlibext))=target_info.sharedlibext then
- Delete(s,length(s)-length(target_info.sharedlibext)+1,length(target_info.sharedlibext)+1);
- { ready to be added }
- SharedLibFiles.Concat(S);
- end;
- Procedure TLinker.AddStaticLibrary(const S:TCmdStr);
- var
- ns : TCmdStr;
- found : boolean;
- begin
- if s='' then
- exit;
- found:=FindLibraryFile(s,target_info.staticlibprefix,target_info.staticlibext,ns);
- if not(cs_link_nolink in current_settings.globalswitches) and (not found) then
- Message1(exec_w_libfile_not_found,s);
- StaticLibFiles.Concat(ns);
- end;
- Procedure TLinker.AddSharedCLibrary(S:TCmdStr);
- begin
- if s='' then
- exit;
- { remove prefix 'lib' }
- if Copy(s,1,length(target_info.sharedclibprefix))=target_info.sharedclibprefix then
- Delete(s,1,length(target_info.sharedclibprefix));
- { remove extension if any }
- if Copy(s,length(s)-length(target_info.sharedclibext)+1,length(target_info.sharedclibext))=target_info.sharedclibext then
- Delete(s,length(s)-length(target_info.sharedclibext)+1,length(target_info.sharedclibext)+1);
- { ready to be added }
- SharedLibFiles.Concat(S);
- end;
- Procedure TLinker.AddFramework(S:TCmdStr);
- begin
- if s='' then
- exit;
- { ready to be added }
- FrameworkFiles.Concat(S);
- end;
- procedure TLinker.AddOrderedSymbol(const s: TCmdStr);
- begin
- OrderedSymbols.Concat(s);
- end;
- Procedure TLinker.AddStaticCLibrary(const S:TCmdStr);
- var
- ns : TCmdStr;
- found : boolean;
- begin
- if s='' then
- exit;
- found:=FindLibraryFile(s,target_info.staticclibprefix,target_info.staticclibext,ns);
- if not(cs_link_nolink in current_settings.globalswitches) and (not found) then
- Message1(exec_w_libfile_not_found,s);
- StaticLibFiles.Concat(ns);
- end;
- procedure TLinker.InitSysInitUnitName;
- begin
- end;
- function TLinker.MakeExecutable:boolean;
- begin
- MakeExecutable:=false;
- Message(exec_e_exe_not_supported);
- end;
- Function TLinker.MakeSharedLibrary:boolean;
- begin
- MakeSharedLibrary:=false;
- Message(exec_e_dll_not_supported);
- end;
- Function TLinker.MakeStaticLibrary:boolean;
- begin
- MakeStaticLibrary:=false;
- Message(exec_e_static_lib_not_supported);
- end;
- Procedure TLinker.ExpandAndApplyOrder(var Src:TCmdStrList);
- var
- p : TLinkStrMap;
- i : longint;
- begin
- // call Virtual TLinker method to initialize
- LoadPredefinedLibraryOrder;
- // something to do?
- if (LinkLibraryAliases.count=0) and (LinkLibraryOrder.Count=0) Then
- exit;
- p:=TLinkStrMap.Create;
- // expand libaliases, clears src
- LinkLibraryAliases.expand(src,p);
- // writeln(src.count,' ',p.count,' ',linklibraryorder.count,' ',linklibraryaliases.count);
- // apply order
- p.UpdateWeights(LinkLibraryOrder);
- p.SortOnWeight;
- // put back in src
- for i:=0 to p.count-1 do
- src.insert(p[i].Key);
- p.free;
- end;
- procedure TLinker.LoadPredefinedLibraryOrder;
- begin
- end;
- function TLinker.ReOrderEntries : boolean;
- begin
- result:=(LinkLibraryOrder.count>0) or (LinkLibraryAliases.count>0);
- end;
- {*****************************************************************************
- TEXTERNALLINKER
- *****************************************************************************}
- Function TExternalLinker.WriteSymbolOrderFile: TCmdStr;
- var
- item: TCmdStrListItem;
- symfile: TScript;
- begin
- result:='';
- { only for darwin for now; can also enable for other platforms when using
- the LLVM linker }
- if (OrderedSymbols.Empty) or
- not(tf_supports_symbolorderfile in target_info.flags) then
- exit;
- symfile:=TScript.Create(outputexedir+UniqueName('symbol_order')+'.fpc');
- item:=TCmdStrListItem(OrderedSymbols.First);
- while assigned(item) do
- begin
- symfile.add(item.str);
- item:=TCmdStrListItem(item.next);
- end;
- symfile.WriteToDisk;
- result:=symfile.fn;
- symfile.Free;
- end;
- Constructor TExternalLinker.Create;
- begin
- inherited Create;
- { set generic defaults }
- FillChar(Info,sizeof(Info),0);
- if cs_link_on_target in current_settings.globalswitches then
- begin
- Info.ResName:=ChangeFileExt(inputfilename,'_link.res');
- Info.ScriptName:=ChangeFileExt(inputfilename,'_script.res');
- end
- else
- begin
- Info.ResName:=UniqueName('link')+'.res';
- Info.ScriptName:=UniqueName('script')+'.res';
- end;
- { set the linker specific defaults }
- SetDefaultInfo;
- { Allow Parameter overrides for linker info }
- with Info do
- begin
- if ParaLinkOptions<>'' then
- ExtraOptions:=ParaLinkOptions;
- if ParaDynamicLinker<>'' then
- DynamicLinker:=ParaDynamicLinker;
- end;
- end;
- Destructor TExternalLinker.Destroy;
- begin
- inherited destroy;
- end;
- Procedure TExternalLinker.SetDefaultInfo;
- begin
- end;
- Function TExternalLinker.FindUtil(const s:TCmdStr):TCmdStr;
- var
- Found : boolean;
- FoundBin : TCmdStr;
- UtilExe : TCmdStr;
- begin
- if cs_link_on_target in current_settings.globalswitches then
- begin
- { If linking on target, don't add any path PM }
- { change extension only on platforms that use an exe extension, otherwise on OpenBSD 'ld.bfd' gets
- converted to 'ld' }
- if target_info.exeext<>'' then
- FindUtil:=ChangeFileExt(s,target_info.exeext)
- else
- FindUtil:=s;
- exit;
- end;
- { change extension only on platforms that use an exe extension, otherwise on OpenBSD 'ld.bfd' gets converted
- to 'ld' }
- if source_info.exeext<>'' then
- UtilExe:=ChangeFileExt(s,source_info.exeext)
- else
- UtilExe:=s;
- FoundBin:='';
- Found:=false;
- if utilsdirectory<>'' then
- Found:=FindFile(utilexe,utilsdirectory,false,Foundbin);
- if (not Found) then
- Found:=FindExe(utilexe,false,Foundbin);
- if (not Found) and not(cs_link_nolink in current_settings.globalswitches) then
- begin
- Message1(exec_e_util_not_found,utilexe);
- current_settings.globalswitches:=current_settings.globalswitches+[cs_link_nolink];
- end;
- if (FoundBin<>'') then
- Message1(exec_t_using_util,FoundBin);
- FindUtil:=FoundBin;
- end;
- Function TExternalLinker.CatFileContent(para : TCmdStr) : TCmdStr;
- var
- filecontent : TCmdStr;
- f : text;
- st : TCmdStr;
- begin
- if not (tf_no_backquote_support in source_info.flags) or
- (cs_link_on_target in current_settings.globalswitches) then
- begin
- CatFileContent:='`cat '+MaybeQuoted(para)+'`';
- Exit;
- end;
- assign(f,para);
- filecontent:='';
- {$push}{$I-}
- reset(f);
- {$pop}
- if IOResult<>0 then
- begin
- Message1(exec_n_backquote_cat_file_not_found,para);
- end
- else
- begin
- while not eof(f) do
- begin
- readln(f,st);
- if st<>'' then
- filecontent:=filecontent+' '+st;
- end;
- close(f);
- end;
- CatFileContent:=filecontent;
- end;
- Function TExternalLinker.DoExec(const command:TCmdStr; para:TCmdStr;showinfo,useshell:boolean):boolean;
- var
- exitcode: longint;
- begin
- DoExec:=true;
- if not(cs_link_nolink in current_settings.globalswitches) then
- begin
- FlushOutput;
- if useshell then
- exitcode:=shell(maybequoted(command)+' '+para)
- else
- try
- exitcode:=RequotedExecuteProcess(command,para);
- except on E:EOSError do
- begin
- Message(exec_e_cant_call_linker);
- current_settings.globalswitches:=current_settings.globalswitches+[cs_link_nolink];
- DoExec:=false;
- end;
- end;
- if (exitcode<>0) then
- begin
- Message(exec_e_error_while_linking);
- current_settings.globalswitches:=current_settings.globalswitches+[cs_link_nolink];
- DoExec:=false;
- end;
- end;
- { Update asmres when externmode is set }
- if cs_link_nolink in current_settings.globalswitches then
- begin
- if showinfo then
- begin
- if current_module.islibrary then
- AsmRes.AddLinkCommand(Command,Para,current_module.sharedlibfilename)
- else
- AsmRes.AddLinkCommand(Command,Para,current_module.exefilename);
- end
- else
- AsmRes.AddLinkCommand(Command,Para,'');
- end;
- end;
- Function TExternalLinker.MakeStaticLibrary:boolean;
- function GetNextFiles(const maxCmdLength : Longint; var item : TCmdStrListItem; const addfilecmd : string) : TCmdStr;
- begin
- result := '';
- while (assigned(item) and ((length(result) + length(item.str) + 1) < maxCmdLength)) do begin
- result := result + ' ' + addfilecmd + item.str;
- item := TCmdStrListItem(item.next);
- end;
- end;
- function get_wlib_record_size: integer;
- begin
- result:=align(align(SmartLinkOFiles.Count,128) div 128,16);
- end;
- var
- binstr, firstbinstr, scriptfile : TCmdStr;
- cmdstr, firstcmd, nextcmd, smartpath : TCmdStr;
- current : TCmdStrListItem;
- script: Text;
- scripted_ar : boolean;
- ar_creates_different_output_file : boolean;
- success : boolean;
- first : boolean;
- begin
- MakeStaticLibrary:=false;
- { remove the library, to be sure that it is rewritten }
- DeleteFile(current_module.staticlibfilename);
- { Call AR }
- smartpath:=FixPath(ChangeFileExt(current_module.asmfilename,target_info.smartext),false);
- SplitBinCmd(target_ar.arcmd,binstr,cmdstr);
- binstr := FindUtil(utilsprefix + binstr);
- if target_ar.arfirstcmd<>'' then
- begin
- SplitBinCmd(target_ar.arfirstcmd,firstbinstr,firstcmd);
- firstbinstr := FindUtil(utilsprefix + firstbinstr);
- end
- else
- begin
- firstbinstr:=binstr;
- firstcmd:=cmdstr;
- end;
- scripted_ar:=(target_ar.id=ar_gnu_ar_scripted) or
- (target_ar.id=ar_watcom_wlib_omf_scripted) or
- (target_ar.id=ar_sdcc_sdar_scripted);
- if scripted_ar then
- begin
- scriptfile := FixFileName(smartpath+'arscript.txt');
- Replace(cmdstr,'$SCRIPT',maybequoted(scriptfile));
- Assign(script, scriptfile);
- Rewrite(script);
- try
- if (target_ar.id in [ar_gnu_ar_scripted,ar_sdcc_sdar_scripted]) then
- writeln(script, 'CREATE ' + current_module.staticlibfilename)
- else { wlib case }
- writeln(script,'-q -p=',get_wlib_record_size,' -fo -c -b '+
- maybequoted(current_module.staticlibfilename));
- current := TCmdStrListItem(SmartLinkOFiles.First);
- while current <> nil do
- begin
- if (target_ar.id in [ar_gnu_ar_scripted,ar_sdcc_sdar_scripted]) then
- writeln(script, 'ADDMOD ' + current.str)
- else
- writeln(script,'+' + current.str);
- current := TCmdStrListItem(current.next);
- end;
- if (target_ar.id in [ar_gnu_ar_scripted,ar_sdcc_sdar_scripted]) then
- begin
- writeln(script, 'SAVE');
- writeln(script, 'END');
- end;
- finally
- Close(script);
- end;
- success:=DoExec(binstr,cmdstr,false,true);
- end
- else
- begin
- ar_creates_different_output_file:=(Pos('$OUTPUTLIB',cmdstr)>0) or (Pos('$OUTPUTLIB',firstcmd)>0);
- Replace(cmdstr,'$LIB',maybequoted(current_module.staticlibfilename));
- Replace(firstcmd,'$LIB',maybequoted(current_module.staticlibfilename));
- Replace(cmdstr,'$OUTPUTLIB',maybequoted(current_module.staticlibfilename+'.tmp'));
- Replace(firstcmd,'$OUTPUTLIB',maybequoted(current_module.staticlibfilename+'.tmp'));
- if target_ar.id=ar_watcom_wlib_omf then
- begin
- Replace(cmdstr,'$RECSIZE','-p='+IntToStr(get_wlib_record_size));
- Replace(firstcmd,'$RECSIZE','-p='+IntToStr(get_wlib_record_size));
- end;
- { create AR commands }
- success := true;
- current := TCmdStrListItem(SmartLinkOFiles.First);
- first := true;
- repeat
- if first then
- nextcmd := firstcmd
- else
- nextcmd := cmdstr;
- Replace(nextcmd,'$FILES',GetNextFiles(2047, current, target_ar.addfilecmd));
- if first then
- success:=DoExec(firstbinstr,nextcmd,false,true)
- else
- success:=DoExec(binstr,nextcmd,false,true);
- if ar_creates_different_output_file then
- begin
- if FileExists(current_module.staticlibfilename,false) then
- DeleteFile(current_module.staticlibfilename);
- if FileExists(current_module.staticlibfilename+'.tmp',false) then
- RenameFile(current_module.staticlibfilename+'.tmp',current_module.staticlibfilename);
- end;
- first := false;
- until (not assigned(current)) or (not success);
- end;
- if (target_ar.arfinishcmd <> '') then
- begin
- SplitBinCmd(target_ar.arfinishcmd,binstr,cmdstr);
- binstr := FindUtil(utilsprefix + binstr);
- Replace(cmdstr,'$LIB',maybequoted(current_module.staticlibfilename));
- success:=DoExec(binstr,cmdstr,false,true);
- end;
- { Clean up }
- if not(cs_asm_leave in current_settings.globalswitches) then
- if not(cs_link_nolink in current_settings.globalswitches) then
- begin
- while not SmartLinkOFiles.Empty do
- DeleteFile(SmartLinkOFiles.GetFirst);
- if scripted_ar then
- DeleteFile(scriptfile);
- RemoveDir(smartpath);
- end
- else
- begin
- while not SmartLinkOFiles.Empty do
- AsmRes.AddDeleteCommand(SmartLinkOFiles.GetFirst);
- if scripted_ar then
- AsmRes.AddDeleteCommand(scriptfile);
- AsmRes.AddDeleteDirCommand(smartpath);
- end;
- MakeStaticLibrary:=success;
- end;
- function TExternalLinker.UniqueName(const str: TCmdStr): TCmdStr;
- const
- pid: SizeUInt = 0;
- begin
- if pid=0 then
- pid:=GetProcessID;
- if pid>0 then
- result:=str+tostr(pid)
- else
- result:=str;
- end;
- function TExternalLinker.PostProcessELFExecutable(const fn : string;isdll:boolean):boolean;
- type
- TElf32header=packed record
- magic0123 : array[0..3] of char;
- file_class : byte;
- data_encoding : byte;
- file_version : byte;
- padding : array[$07..$0f] of byte;
- e_type : word;
- e_machine : word;
- e_version : longint;
- e_entry : longint; { entrypoint }
- e_phoff : longint; { program header offset }
- e_shoff : longint; { sections header offset }
- e_flags : longint;
- e_ehsize : word; { elf header size in bytes }
- e_phentsize : word; { size of an entry in the program header array }
- e_phnum : word; { 0..e_phnum-1 of entrys }
- e_shentsize : word; { size of an entry in sections header array }
- e_shnum : word; { 0..e_shnum-1 of entrys }
- e_shstrndx : word; { index of string section header }
- end;
- TElf32sechdr=packed record
- sh_name : longint;
- sh_type : longint;
- sh_flags : longint;
- sh_addr : longint;
- sh_offset : longint;
- sh_size : longint;
- sh_link : longint;
- sh_info : longint;
- sh_addralign : longint;
- sh_entsize : longint;
- end;
- telf64header=packed record
- magic0123 : array[0..3] of char;
- file_class : byte;
- data_encoding : byte;
- file_version : byte;
- padding : array[$07..$0f] of byte;
- e_type : word;
- e_machine : word;
- e_version : longword;
- e_entry : qword; { entrypoint }
- e_phoff : qword; { program header offset }
- e_shoff : qword; { sections header offset }
- e_flags : longword;
- e_ehsize : word; { elf header size in bytes }
- e_phentsize : word; { size of an entry in the program header array }
- e_phnum : word; { 0..e_phnum-1 of entrys }
- e_shentsize : word; { size of an entry in sections header array }
- e_shnum : word; { 0..e_shnum-1 of entrys }
- e_shstrndx : word; { index of string section header }
- end;
- TElf64sechdr=packed record
- sh_name : longword;
- sh_type : longword;
- sh_flags : qword;
- sh_addr : qword;
- sh_offset : qword;
- sh_size : qword;
- sh_link : longword;
- sh_info : longword;
- sh_addralign : qword;
- sh_entsize : qword;
- end;
- function MayBeSwapHeader(h : telf32header) : telf32header;
- begin
- result:=h;
- if source_info.endian<>target_info.endian then
- with h do
- begin
- result.e_type:=swapendian(e_type);
- result.e_machine:=swapendian(e_machine);
- result.e_version:=swapendian(e_version);
- result.e_entry:=swapendian(e_entry);
- result.e_phoff:=swapendian(e_phoff);
- result.e_shoff:=swapendian(e_shoff);
- result.e_flags:=swapendian(e_flags);
- result.e_ehsize:=swapendian(e_ehsize);
- result.e_phentsize:=swapendian(e_phentsize);
- result.e_phnum:=swapendian(e_phnum);
- result.e_shentsize:=swapendian(e_shentsize);
- result.e_shnum:=swapendian(e_shnum);
- result.e_shstrndx:=swapendian(e_shstrndx);
- end;
- end;
- function MayBeSwapHeader(h : telf64header) : telf64header;
- begin
- result:=h;
- if source_info.endian<>target_info.endian then
- with h do
- begin
- result.e_type:=swapendian(e_type);
- result.e_machine:=swapendian(e_machine);
- result.e_version:=swapendian(e_version);
- result.e_entry:=swapendian(e_entry);
- result.e_phoff:=swapendian(e_phoff);
- result.e_shoff:=swapendian(e_shoff);
- result.e_flags:=swapendian(e_flags);
- result.e_ehsize:=swapendian(e_ehsize);
- result.e_phentsize:=swapendian(e_phentsize);
- result.e_phnum:=swapendian(e_phnum);
- result.e_shentsize:=swapendian(e_shentsize);
- result.e_shnum:=swapendian(e_shnum);
- result.e_shstrndx:=swapendian(e_shstrndx);
- end;
- end;
- function MaybeSwapSecHeader(h : telf32sechdr) : telf32sechdr;
- begin
- result:=h;
- if source_info.endian<>target_info.endian then
- with h do
- begin
- result.sh_name:=swapendian(sh_name);
- result.sh_type:=swapendian(sh_type);
- result.sh_flags:=swapendian(sh_flags);
- result.sh_addr:=swapendian(sh_addr);
- result.sh_offset:=swapendian(sh_offset);
- result.sh_size:=swapendian(sh_size);
- result.sh_link:=swapendian(sh_link);
- result.sh_info:=swapendian(sh_info);
- result.sh_addralign:=swapendian(sh_addralign);
- result.sh_entsize:=swapendian(sh_entsize);
- end;
- end;
- function MaybeSwapSecHeader(h : telf64sechdr) : telf64sechdr;
- begin
- result:=h;
- if source_info.endian<>target_info.endian then
- with h do
- begin
- result.sh_name:=swapendian(sh_name);
- result.sh_type:=swapendian(sh_type);
- result.sh_flags:=swapendian(sh_flags);
- result.sh_addr:=swapendian(sh_addr);
- result.sh_offset:=swapendian(sh_offset);
- result.sh_size:=swapendian(sh_size);
- result.sh_link:=swapendian(sh_link);
- result.sh_info:=swapendian(sh_info);
- result.sh_addralign:=swapendian(sh_addralign);
- result.sh_entsize:=swapendian(sh_entsize);
- end;
- end;
- var
- f : file;
- function ReadSectionName(pos : longint) : String;
- var
- oldpos : longint;
- c : char;
- begin
- oldpos:=filepos(f);
- seek(f,pos);
- Result:='';
- while true do
- begin
- blockread(f,c,1);
- if c=#0 then
- break;
- Result:=Result+c;
- end;
- seek(f,oldpos);
- end;
- var
- elfheader32 : TElf32header;
- secheader32 : TElf32sechdr;
- elfheader64 : TElf64header;
- secheader64 : TElf64sechdr;
- i : longint;
- stringoffset : longint;
- secname : string;
- begin
- Result:=false;
- { open file }
- assign(f,fn);
- {$push}{$I-}
- reset(f,1);
- if ioresult<>0 then
- Message1(execinfo_f_cant_open_executable,fn);
- { read header }
- blockread(f,elfheader32,sizeof(tElf32header));
- with elfheader32 do
- if not((magic0123[0]=#$7f) and (magic0123[1]='E') and (magic0123[2]='L') and (magic0123[3]='F')) then
- Exit;
- case elfheader32.file_class of
- 1:
- begin
- elfheader32:=MayBeSwapHeader(elfheader32);
- seek(f,elfheader32.e_shoff);
- { read string section header }
- seek(f,elfheader32.e_shoff+sizeof(TElf32sechdr)*elfheader32.e_shstrndx);
- blockread(f,secheader32,sizeof(secheader32));
- secheader32:=MaybeSwapSecHeader(secheader32);
- stringoffset:=secheader32.sh_offset;
- seek(f,elfheader32.e_shoff);
- status.datasize:=0;
- for i:=0 to elfheader32.e_shnum-1 do
- begin
- blockread(f,secheader32,sizeof(secheader32));
- secheader32:=MaybeSwapSecHeader(secheader32);
- secname:=ReadSectionName(stringoffset+secheader32.sh_name);
- case secname of
- '.text':
- begin
- Message1(execinfo_x_codesize,tostr(secheader32.sh_size));
- status.codesize:=secheader32.sh_size;
- end;
- '.fpcdata',
- '.rodata',
- '.data':
- begin
- Message1(execinfo_x_initdatasize,tostr(secheader32.sh_size));
- inc(status.datasize,secheader32.sh_size);
- end;
- '.bss':
- begin
- Message1(execinfo_x_uninitdatasize,tostr(secheader32.sh_size));
- inc(status.datasize,secheader32.sh_size);
- end;
- end;
- end;
- end;
- 2:
- begin
- seek(f,0);
- blockread(f,elfheader64,sizeof(tElf64header));
- with elfheader64 do
- if not((magic0123[0]=#$7f) and (magic0123[1]='E') and (magic0123[2]='L') and (magic0123[3]='F')) then
- Exit;
- elfheader64:=MayBeSwapHeader(elfheader64);
- seek(f,elfheader64.e_shoff);
- { read string section header }
- seek(f,elfheader64.e_shoff+sizeof(TElf64sechdr)*elfheader64.e_shstrndx);
- blockread(f,secheader64,sizeof(secheader64));
- secheader64:=MaybeSwapSecHeader(secheader64);
- stringoffset:=secheader64.sh_offset;
- seek(f,elfheader64.e_shoff);
- status.datasize:=0;
- for i:=0 to elfheader64.e_shnum-1 do
- begin
- blockread(f,secheader64,sizeof(secheader64));
- secheader64:=MaybeSwapSecHeader(secheader64);
- secname:=ReadSectionName(stringoffset+secheader64.sh_name);
- case secname of
- '.text':
- begin
- Message1(execinfo_x_codesize,tostr(secheader64.sh_size));
- status.codesize:=secheader64.sh_size;
- end;
- '.fpcdata',
- '.rodata',
- '.data':
- begin
- Message1(execinfo_x_initdatasize,tostr(secheader64.sh_size));
- inc(status.datasize,secheader64.sh_size);
- end;
- '.bss':
- begin
- Message1(execinfo_x_uninitdatasize,tostr(secheader64.sh_size));
- inc(status.datasize,secheader64.sh_size);
- end;
- end;
- end;
- end;
- else
- exit;
- end;
- close(f);
- {$pop}
- if ioresult<>0 then
- ;
- Result:=true;
- end;
- {*****************************************************************************
- TINTERNALLINKER
- *****************************************************************************}
- Constructor TInternalLinker.Create;
- begin
- inherited Create;
- linkscript:=TCmdStrList.Create;
- FStaticLibraryList:=TFPObjectList.Create(true);
- FImportLibraryList:=TFPHashObjectList.Create(true);
- FGroupStack:=TFPObjectList.Create(false);
- exemap:=nil;
- exeoutput:=nil;
- UseStabs:=false;
- CObjInput:=TObjInput;
- ScriptCount:=0;
- IsHandled:=nil;
- end;
- Destructor TInternalLinker.Destroy;
- begin
- FGroupStack.Free;
- linkscript.free;
- StaticLibraryList.Free;
- ImportLibraryList.Free;
- if assigned(IsHandled) then
- begin
- FreeMem(IsHandled,sizeof(boolean)*ScriptCount);
- IsHandled:=nil;
- ScriptCount:=0;
- end;
- if assigned(exeoutput) then
- begin
- exeoutput.free;
- exeoutput:=nil;
- end;
- if assigned(exemap) then
- begin
- exemap.free;
- exemap:=nil;
- end;
- inherited destroy;
- end;
- procedure TInternalLinker.AddImportSymbol(const libname,symname,symmangledname:TCmdStr;OrdNr: longint;isvar:boolean);
- var
- ImportLibrary : TImportLibrary;
- ImportSymbol : TFPHashObject;
- begin
- ImportLibrary:=TImportLibrary(ImportLibraryList.Find(libname));
- if not assigned(ImportLibrary) then
- ImportLibrary:=TImportLibrary.Create(ImportLibraryList,libname);
- ImportSymbol:=TFPHashObject(ImportLibrary.ImportSymbolList.Find(symname));
- if not assigned(ImportSymbol) then
- ImportSymbol:=TImportSymbol.Create(ImportLibrary.ImportSymbolList,symname,symmangledname,OrdNr,isvar);
- end;
- procedure TInternalLinker.ScriptAddSourceStatements(AddSharedAsStatic:boolean);
- var
- s,s2: TCmdStr;
- begin
- while not ObjectFiles.Empty do
- begin
- s:=ObjectFiles.GetFirst;
- if s<>'' then
- LinkScript.Concat('READOBJECT '+MaybeQuoted(s));
- end;
- while not StaticLibFiles.Empty do
- begin
- s:=StaticLibFiles.GetFirst;
- if s<>'' then
- LinkScript.Concat('READSTATICLIBRARY '+MaybeQuoted(s));
- end;
- if not AddSharedAsStatic then
- exit;
- while not SharedLibFiles.Empty do
- begin
- S:=SharedLibFiles.GetFirst;
- if FindLibraryFile(s,target_info.staticClibprefix,target_info.staticClibext,s2) then
- LinkScript.Concat('READSTATICLIBRARY '+MaybeQuoted(s2))
- else
- Comment(V_Error,'Import library not found for '+S);
- end;
- end;
- function TInternalLinker.GetCodeSize(aExeOutput: TExeOutput): QWord;
- begin
- Result:=aExeOutput.findexesection('.text').size;
- end;
- function TInternalLinker.GetDataSize(aExeOutput: TExeOutput): QWord;
- begin
- Result:=aExeOutput.findexesection('.data').size;
- end;
- function TInternalLinker.GetBssSize(aExeOutput: TExeOutput): QWord;
- var
- bsssec: TExeSection;
- begin
- bsssec:=aExeOutput.findexesection('.bss');
- if assigned(bsssec) then
- Result:=bsssec.size
- else
- Result:=0;
- end;
- procedure TInternalLinker.ParseLdScript(src:TScriptLexer);
- var
- asneeded: boolean;
- group: TStaticLibrary;
- procedure ParseInputList;
- var
- saved_asneeded: boolean;
- begin
- src.Expect('(');
- repeat
- if src.CheckForIdent('AS_NEEDED') then
- begin
- saved_asneeded:=asneeded;
- asneeded:=true;
- ParseInputList;
- asneeded:=saved_asneeded;
- end
- else if src.token in [tkIDENT,tkLITERAL] then
- begin
- Load_ReadStaticLibrary(src.tokenstr,asneeded);
- src.nextToken;
- end
- else if src.CheckFor('-') then
- begin
- { TODO: no whitespace between '-' and name;
- name must begin with 'l' }
- src.nextToken;
- end
- else { syntax error, no input_list_element term }
- Break;
- if src.CheckFor(',') then
- Continue;
- until src.CheckFor(')');
- end;
- begin
- asneeded:=false;
- src.nextToken;
- repeat
- if src.CheckForIdent('OUTPUT_FORMAT') then
- begin
- src.Expect('(');
- //writeln('output_format(',src.tokenstr,')');
- src.nextToken;
- src.Expect(')');
- end
- else if src.CheckForIdent('GROUP') then
- begin
- group:=TStaticLibrary.create_group;
- TFPObjectList(FGroupStack.Last).Add(group);
- FGroupStack.Add(group.GroupMembers);
- ParseInputList;
- FGroupStack.Delete(FGroupStack.Count-1);
- end
- else if src.CheckFor(';') then
- {skip semicolon};
- until src.token in [tkEOF,tkINVALID];
- end;
- procedure TInternalLinker.Load_ReadObject(const para:TCmdStr);
- var
- objdata : TObjData;
- objinput : TObjinput;
- objreader : TObjectReader;
- fn : TCmdStr;
- begin
- fn:=FindObjectFile(para,'',false);
- Comment(V_Tried,'Reading object '+fn);
- objinput:=CObjInput.Create;
- objreader:=TObjectreader.create;
- if objreader.openfile(fn) then
- begin
- if objinput.ReadObjData(objreader,objdata) then
- exeoutput.addobjdata(objdata);
- end;
- { release input object }
- objinput.free;
- objreader.free;
- end;
- procedure TInternalLinker.Load_ReadStaticLibrary(const para:TCmdStr;asneededflag:boolean);
- var
- objreader : TObjectReader;
- objinput: TObjInput;
- objdata: TObjData;
- ScriptLexer: TScriptLexer;
- stmt:TStaticLibrary;
- begin
- { TODO: Cleanup ignoring of FPC generated libimp*.a files}
- { Don't load import libraries }
- if copy(ExtractFileName(para),1,6)='libimp' then
- exit;
- Comment(V_Tried,'Opening library '+para);
- objreader:=CArObjectreader.createAr(para,true);
- if ErrorCount>0 then
- exit;
- if objreader.isarchive then
- TFPObjectList(FGroupStack.Last).Add(TStaticLibrary.Create(para,objreader,CObjInput))
- else
- if CObjInput.CanReadObjData(objreader) then
- begin
- { may be a regular object as well as a dynamic one }
- objinput:=CObjInput.Create;
- if objinput.ReadObjData(objreader,objdata) then
- begin
- stmt:=TStaticLibrary.create_object(objdata);
- stmt.AsNeeded:=asneededflag;
- TFPObjectList(FGroupStack.Last).Add(stmt);
- end;
- objinput.Free;
- objreader.Free;
- end
- else { try parsing as script }
- begin
- Comment(V_Tried,'Interpreting '+para+' as ld script');
- ScriptLexer:=TScriptLexer.Create(objreader);
- ParseLdScript(ScriptLexer);
- ScriptLexer.Free;
- objreader.Free;
- end;
- end;
- procedure TInternalLinker.Load_Group;
- var
- group: TStaticLibrary;
- begin
- group:=TStaticLibrary.create_group;
- TFPObjectList(FGroupStack.Last).Add(group);
- FGroupStack.Add(group.GroupMembers);
- end;
- procedure TInternalLinker.Load_EndGroup;
- begin
- FGroupStack.Delete(FGroupStack.Count-1);
- end;
- procedure TInternalLinker.ParseScript_Handle;
- var
- s{, para}, keyword : String;
- hp : TCmdStrListItem;
- i : longint;
- begin
- hp:=TCmdStrListItem(linkscript.first);
- i:=0;
- while assigned(hp) do
- begin
- inc(i);
- s:=hp.str;
- if (s='') or (s[1]='#') then
- begin
- hp:=TCmdStrListItem(hp.next);
- continue;
- end;
- keyword:=Upper(GetToken(s,' '));
- {para:=}GetToken(s,' ');
- if Trim(s)<>'' then
- Comment(V_Warning,'Unknown part "'+s+'" in "'+hp.str+'" internal linker script');
- if (keyword<>'SYMBOL') and
- (keyword<>'SYMBOLS') and
- (keyword<>'STABS') and
- (keyword<>'PROVIDE') and
- (keyword<>'ZEROS') and
- (keyword<>'BYTE') and
- (keyword<>'WORD') and
- (keyword<>'LONG') and
- (keyword<>'QUAD') and
- (keyword<>'ENTRYNAME') and
- (keyword<>'ISSHAREDLIBRARY') and
- (keyword<>'IMAGEBASE') and
- (keyword<>'READOBJECT') and
- (keyword<>'READSTATICLIBRARY') and
- (keyword<>'EXESECTION') and
- (keyword<>'ENDEXESECTION') and
- (keyword<>'OBJSECTION') and
- (keyword<>'HEADER') and
- (keyword<>'GROUP') and
- (keyword<>'ENDGROUP')
- then
- Comment(V_Warning,'Unknown keyword "'+keyword+'" in "'+hp.str
- +'" internal linker script');
- hp:=TCmdStrListItem(hp.next);
- end;
- ScriptCount:=i;
- if ScriptCount>0 then
- begin
- GetMem(IsHandled,sizeof(boolean)*ScriptCount);
- Fillchar(IsHandled^,sizeof(boolean)*ScriptCount,#0);
- end;
- end;
- procedure TInternalLinker.ParseScript_PostCheck;
- var
- hp : TCmdStrListItem;
- i : longint;
- begin
- hp:=TCmdStrListItem(linkscript.first);
- i:=0;
- while assigned(hp) do
- begin
- inc(i);
- if not IsHandled^[i] then
- begin
- Comment(V_Warning,'"'+hp.str+
- '" internal linker script not handled');
- end;
- hp:=TCmdStrListItem(hp.next);
- end;
- end;
- function TInternalLinker.ParsePara(const para : string) : string;
- var
- res : string;
- begin
- res:=trim(para);
- { Remove enclosing braces }
- if (length(res)>0) and (res[1]='(') and
- (res[length(res)]=')') then
- res:=trim(copy(res,2,length(res)-2));
- result:=res;
- end;
- procedure TInternalLinker.ParseScript_Load;
- var
- s,
- para,
- keyword : String;
- hp : TCmdStrListItem;
- i : longint;
- handled : boolean;
- begin
- exeoutput.Load_Start;
- hp:=TCmdStrListItem(linkscript.first);
- i:=0;
- while assigned(hp) do
- begin
- inc(i);
- s:=hp.str;
- if (s='') or (s[1]='#') then
- begin
- IsHandled^[i]:=true;
- hp:=TCmdStrListItem(hp.next);
- continue;
- end;
- handled:=true;
- keyword:=Upper(GetToken(s,' '));
- para:=ParsePara(GetToken(s,' '));
- if keyword='SYMBOL' then
- ExeOutput.Load_Symbol(para)
- else if keyword='PROVIDE' then
- ExeOutput.Load_ProvideSymbol(para)
- else if keyword='ENTRYNAME' then
- ExeOutput.Load_EntryName(para)
- else if keyword='ISSHAREDLIBRARY' then
- ExeOutput.Load_IsSharedLibrary
- else if keyword='IMAGEBASE' then
- ExeOutput.Load_ImageBase(para)
- else if keyword='READOBJECT' then
- Load_ReadObject(para)
- else if keyword='STABS' then
- UseStabs:=true
- else if keyword='READSTATICLIBRARY' then
- Load_ReadStaticLibrary(para)
- else if keyword='GROUP' then
- Load_Group
- else if keyword='ENDGROUP' then
- Load_EndGroup
- else
- handled:=false;
- if handled then
- IsHandled^[i]:=true;
- hp:=TCmdStrListItem(hp.next);
- end;
- end;
- procedure TInternalLinker.ParseScript_Order;
- var
- s,
- para,
- keyword : String;
- hp : TCmdStrListItem;
- i : longint;
- handled : boolean;
- begin
- exeoutput.Order_Start;
- hp:=TCmdStrListItem(linkscript.first);
- i:=0;
- while assigned(hp) do
- begin
- inc(i);
- s:=hp.str;
- if (s='') or (s[1]='#') then
- begin
- hp:=TCmdStrListItem(hp.next);
- continue;
- end;
- handled:=true;
- keyword:=Upper(GetToken(s,' '));
- para:=ParsePara(GetToken(s,' '));
- if keyword='EXESECTION' then
- ExeOutput.Order_ExeSection(para)
- else if keyword='ENDEXESECTION' then
- ExeOutput.Order_EndExeSection
- else if keyword='OBJSECTION' then
- ExeOutput.Order_ObjSection(para)
- else if keyword='ZEROS' then
- ExeOutput.Order_Zeros(para)
- else if keyword='BYTE' then
- ExeOutput.Order_Values(1,para)
- else if keyword='WORD' then
- ExeOutput.Order_Values(2,para)
- else if keyword='LONG' then
- ExeOutput.Order_Values(4,para)
- else if keyword='QUAD' then
- ExeOutput.Order_Values(8,para)
- else if keyword='SYMBOL' then
- ExeOutput.Order_Symbol(para)
- else if keyword='PROVIDE' then
- ExeOutput.Order_ProvideSymbol(para)
- else
- handled:=false;
- if handled then
- IsHandled^[i]:=true;
- hp:=TCmdStrListItem(hp.next);
- end;
- exeoutput.Order_End;
- end;
- procedure TInternalLinker.ParseScript_MemPos;
- var
- s,
- para,
- keyword : String;
- hp : TCmdStrListItem;
- i : longint;
- handled : boolean;
- begin
- exeoutput.MemPos_Start;
- hp:=TCmdStrListItem(linkscript.first);
- i:=0;
- while assigned(hp) do
- begin
- inc(i);
- s:=hp.str;
- if (s='') or (s[1]='#') then
- begin
- hp:=TCmdStrListItem(hp.next);
- continue;
- end;
- handled:=true;
- keyword:=Upper(GetToken(s,' '));
- para:=ParsePara(GetToken(s,' '));
- if keyword='EXESECTION' then
- ExeOutput.MemPos_ExeSection(para)
- else if keyword='ENDEXESECTION' then
- ExeOutput.MemPos_EndExeSection
- else if keyword='HEADER' then
- ExeOutput.MemPos_Header
- else
- handled:=false;
- if handled then
- IsHandled^[i]:=true;
- hp:=TCmdStrListItem(hp.next);
- end;
- end;
- procedure TInternalLinker.ParseScript_DataPos;
- var
- s,
- para,
- keyword : String;
- hp : TCmdStrListItem;
- i : longint;
- handled : boolean;
- begin
- exeoutput.DataPos_Start;
- hp:=TCmdStrListItem(linkscript.first);
- i:=0;
- while assigned(hp) do
- begin
- inc(i);
- s:=hp.str;
- if (s='') or (s[1]='#') then
- begin
- hp:=TCmdStrListItem(hp.next);
- continue;
- end;
- handled:=true;
- keyword:=Upper(GetToken(s,' '));
- para:=ParsePara(GetToken(s,' '));
- if keyword='EXESECTION' then
- ExeOutput.DataPos_ExeSection(para)
- else if keyword='ENDEXESECTION' then
- ExeOutput.DataPos_EndExeSection
- else if keyword='HEADER' then
- ExeOutput.DataPos_Header
- else if keyword='SYMBOLS' then
- ExeOutput.DataPos_Symbols
- else
- handled:=false;
- if handled then
- IsHandled^[i]:=true;
- hp:=TCmdStrListItem(hp.next);
- end;
- end;
- procedure TInternalLinker.PrintLinkerScript;
- var
- hp : TCmdStrListItem;
- begin
- if not assigned(exemap) then
- exit;
- exemap.Add('Used linker script');
- exemap.Add('');
- hp:=TCmdStrListItem(linkscript.first);
- while assigned(hp) do
- begin
- exemap.Add(hp.str);
- hp:=TCmdStrListItem(hp.next);
- end;
- end;
- function TInternalLinker.RunLinkScript(const outputname:TCmdStr):boolean;
- label
- myexit;
- var
- bsssize : qword;
- dbgname : TCmdStr;
- begin
- result:=false;
- Message1(exec_i_linking,outputname);
- FlushOutput;
- exeoutput:=CExeOutput.Create;
- { TODO: Load custom linker script}
- DefaultLinkScript;
- if (cs_link_map in current_settings.globalswitches) then
- exemap:=texemap.create(current_module.mapfilename);
- PrintLinkerScript;
- { Check that syntax is OK }
- ParseScript_Handle;
- { Load .o files and resolve symbols }
- FGroupStack.Add(FStaticLibraryList);
- ParseScript_Load;
- if ErrorCount>0 then
- goto myexit;
- exeoutput.ResolveSymbols(StaticLibraryList);
- { Generate symbols and code to do the importing }
- exeoutput.GenerateLibraryImports(ImportLibraryList);
- { Fill external symbols data }
- exeoutput.FixupSymbols;
- if ErrorCount>0 then
- goto myexit;
- { parse linker options specific for output format }
- exeoutput.ParseScript (linkscript);
- { Create .exe sections and add .o sections }
- ParseScript_Order;
- exeoutput.RemoveUnreferencedSections;
- { if UseStabs then, this would remove
- STABS for empty linker scripts }
- exeoutput.MergeStabs;
- exeoutput.MarkEmptySections;
- exeoutput.AfterUnusedSectionRemoval;
- if ErrorCount>0 then
- goto myexit;
- { Calc positions in mem }
- ParseScript_MemPos;
- exeoutput.FixupRelocations;
- exeoutput.RemoveUnusedExeSymbols;
- exeoutput.PrintMemoryMap;
- if ErrorCount>0 then
- goto myexit;
- if cs_link_separate_dbg_file in current_settings.globalswitches then
- begin
- { create debuginfo, which is an executable without data on disk }
- dbgname:=ChangeFileExt(outputname,'.dbg');
- exeoutput.ExeWriteMode:=ewm_dbgonly;
- ParseScript_DataPos;
- exeoutput.WriteExeFile(dbgname);
- { create executable with link to just created debuginfo file }
- exeoutput.ExeWriteMode:=ewm_exeonly;
- exeoutput.RemoveDebugInfo;
- exeoutput.GenerateDebugLink(ExtractFileName(dbgname),GetFileCRC(dbgname));
- ParseScript_MemPos;
- ParseScript_DataPos;
- exeoutput.WriteExeFile(outputname);
- end
- else
- begin
- exeoutput.ExeWriteMode:=ewm_exefull;
- ParseScript_DataPos;
- exeoutput.WriteExeFile(outputname);
- end;
- { Post check that everything was handled }
- ParseScript_PostCheck;
- status.codesize:=GetCodeSize(exeoutput);
- status.datasize:=GetDataSize(exeoutput);
- bsssize:=GetBssSize(exeoutput);
- { Executable info }
- Message1(execinfo_x_codesize,tostr(status.codesize));
- Message1(execinfo_x_initdatasize,tostr(status.datasize));
- Message1(execinfo_x_uninitdatasize,tostr(bsssize));
- Message1(execinfo_x_stackreserve,tostr(stacksize));
- myexit:
- { close map }
- if assigned(exemap) then
- begin
- exemap.free;
- exemap:=nil;
- end;
- { close exe }
- exeoutput.free;
- exeoutput:=nil;
- result:=true;
- end;
- function TInternalLinker.ExecutableFilename:String;
- begin
- result:=current_module.exefilename;
- end;
- function TInternalLinker.SharedLibFilename:String;
- begin
- result:=current_module.sharedlibfilename;
- end;
- function TInternalLinker.MakeExecutable:boolean;
- begin
- IsSharedLibrary:=false;
- result:=RunLinkScript(ExecutableFilename);
- {$ifdef hasUnix}
- fpchmod(current_module.exefilename,493);
- {$endif hasUnix}
- end;
- function TInternalLinker.MakeSharedLibrary:boolean;
- begin
- IsSharedLibrary:=true;
- result:=RunLinkScript(SharedLibFilename);
- end;
- procedure TInternalLinker.ScriptAddGenericSections(secnames:string);
- var
- secname:string;
- begin
- repeat
- secname:=gettoken(secnames,',');
- if secname='' then
- break;
- linkscript.Concat('EXESECTION '+secname);
- linkscript.Concat(' OBJSECTION '+secname+'*');
- linkscript.Concat('ENDEXESECTION');
- until false;
- end;
- {*****************************************************************************
- Init/Done
- *****************************************************************************}
- procedure RegisterLinker(id:tlink;c:TLinkerClass);
- begin
- CLinker[id]:=c;
- end;
- procedure InitLinker;
- begin
- if (cs_link_extern in current_settings.globalswitches) and
- assigned(CLinker[target_info.linkextern]) then
- begin
- linker:=CLinker[target_info.linkextern].Create;
- end
- else
- if assigned(CLinker[target_info.link]) then
- begin
- linker:=CLinker[target_info.link].Create;
- end
- else
- linker:=Tlinker.Create;
- end;
- procedure DoneLinker;
- begin
- if assigned(linker) then
- Linker.Free;
- end;
- {*****************************************************************************
- Initialize
- *****************************************************************************}
- const
- ar_gnu_ar_info : tarinfo =
- (
- id : ar_gnu_ar;
- addfilecmd : '';
- arfirstcmd : '';
- arcmd : 'ar qS $LIB $FILES';
- arfinishcmd : 'ar s $LIB'
- );
- ar_gnu_ar_scripted_info : tarinfo =
- (
- id : ar_gnu_ar_scripted;
- addfilecmd : '';
- arfirstcmd : '';
- arcmd : 'ar -M < $SCRIPT';
- arfinishcmd : ''
- );
- ar_gnu_gar_info : tarinfo =
- ( id : ar_gnu_gar;
- addfilecmd : '';
- arfirstcmd : '';
- arcmd : 'gar qS $LIB $FILES';
- arfinishcmd : 'gar s $LIB'
- );
- ar_watcom_wlib_omf_info : tarinfo =
- ( id : ar_watcom_wlib_omf;
- addfilecmd : '+';
- arfirstcmd : 'wlib -q $RECSIZE -fo -c -b -n -o=$OUTPUTLIB $LIB $FILES';
- arcmd : 'wlib -q $RECSIZE -fo -c -b -o=$OUTPUTLIB $LIB $FILES';
- arfinishcmd : ''
- );
- ar_watcom_wlib_omf_scripted_info : tarinfo =
- (
- id : ar_watcom_wlib_omf_scripted;
- addfilecmd : '+';
- arfirstcmd : '';
- arcmd : 'wlib @$SCRIPT';
- arfinishcmd : ''
- );
- ar_sdcc_sdar_info : tarinfo =
- ( id : ar_sdcc_sdar;
- addfilecmd : '';
- arfirstcmd : '';
- arcmd : 'sdar qS $LIB $FILES';
- arfinishcmd : 'sdar s $LIB'
- );
- ar_sdcc_sdar_scripted_info : tarinfo =
- (
- id : ar_sdcc_sdar_scripted;
- addfilecmd : '';
- arfirstcmd : '';
- arcmd : 'sdar -M < $SCRIPT';
- arfinishcmd : ''
- );
- initialization
- RegisterAr(ar_gnu_ar_info);
- RegisterAr(ar_gnu_ar_scripted_info);
- RegisterAr(ar_gnu_gar_info);
- RegisterAr(ar_watcom_wlib_omf_info);
- RegisterAr(ar_watcom_wlib_omf_scripted_info);
- RegisterAr(ar_sdcc_sdar_info);
- RegisterAr(ar_sdcc_sdar_scripted_info);
- end.
|