12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721 |
- {
- 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 string;
- 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)
- 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;
- 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;
- 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,
- 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_link_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_link_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;
- cmdstritem: TCmdStrListItem;
- 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
- *****************************************************************************}
- 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
- if GetProcessID>0 then
- begin
- Info.ResName:='link'+tostr(GetProcessID)+'.res';
- Info.ScriptName:='script'+tostr(GetProcessID)+'.res';
- end
- else
- begin
- Info.ResName:='link.res';
- Info.ScriptName:='script.res';
- end;
- 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;
- 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);
- 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=ar_gnu_ar_scripted) then
- writeln(script, 'CREATE ' + current_module.staticlibfilename)
- else { wlib case }
- writeln(script,'-q -fo -c -b '+
- maybequoted(current_module.staticlibfilename));
- current := TCmdStrListItem(SmartLinkOFiles.First);
- while current <> nil do
- begin
- if (target_ar.id=ar_gnu_ar_scripted) then
- writeln(script, 'ADDMOD ' + current.str)
- else
- writeln(script,'+' + current.str);
- current := TCmdStrListItem(current.next);
- end;
- if (target_ar.id=ar_gnu_ar_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'));
- { 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;
- {*****************************************************************************
- 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 : aword;
- 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.MakeExecutable:boolean;
- begin
- IsSharedLibrary:=false;
- result:=RunLinkScript(current_module.exefilename);
- {$ifdef hasUnix}
- fpchmod(current_module.exefilename,493);
- {$endif hasUnix}
- end;
- function TInternalLinker.MakeSharedLibrary:boolean;
- begin
- IsSharedLibrary:=true;
- result:=RunLinkScript(current_module.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 -fo -c -b -n -o=$OUTPUTLIB $LIB $FILES';
- arcmd : 'wlib -q -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 : ''
- );
- 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);
- end.
|