link.pas 79 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345
  1. {
  2. Copyright (c) 1998-2002 by Peter Vreman
  3. This unit handles the linker and binder calls for programs and
  4. libraries
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit link;
  19. {$i fpcdefs.inc}
  20. { $define DEBUG_MACHO_INFO}
  21. interface
  22. uses
  23. sysutils,
  24. cclasses,
  25. systems,
  26. fmodule,
  27. globtype,
  28. ldscript,
  29. ogbase,
  30. owbase;
  31. Type
  32. TLinkerInfo=record
  33. ExeCmd,
  34. DllCmd,
  35. ExtDbgCmd : array[1..3] of ansistring;
  36. ResName : string[100];
  37. ScriptName : string[100];
  38. ExtraOptions : TCmdStr;
  39. DynamicLinker : string[100];
  40. end;
  41. TLinker = class(TObject)
  42. public
  43. HasResources,
  44. HasExports : boolean;
  45. SysInitUnit : string[20];
  46. ObjectFiles,
  47. SharedLibFiles,
  48. StaticLibFiles,
  49. FrameworkFiles,
  50. OrderedSymbols: TCmdStrList;
  51. Constructor Create;virtual;
  52. Destructor Destroy;override;
  53. procedure AddModuleFiles(hp:tmodule);
  54. Procedure AddObject(const S,unitpath : TPathStr;isunit:boolean);
  55. Procedure AddStaticLibrary(const S : TCmdStr);
  56. Procedure AddSharedLibrary(S : TCmdStr);
  57. Procedure AddStaticCLibrary(const S : TCmdStr);
  58. Procedure AddSharedCLibrary(S : TCmdStr);
  59. Procedure AddFramework(S : TCmdStr);
  60. Procedure AddOrderedSymbol(const s: TCmdStr);
  61. procedure AddImportSymbol(const libname,symname,symmangledname:TCmdStr;OrdNr: longint;isvar:boolean);virtual;
  62. Procedure InitSysInitUnitName;virtual;
  63. Function MakeExecutable:boolean;virtual;
  64. Function MakeSharedLibrary:boolean;virtual;
  65. Function MakeStaticLibrary:boolean;virtual;
  66. procedure ExpandAndApplyOrder(var Src:TCmdStrList);
  67. procedure LoadPredefinedLibraryOrder;virtual;
  68. function ReOrderEntries : boolean;
  69. end;
  70. TExternalLinker = class(TLinker)
  71. protected
  72. Function WriteSymbolOrderFile: TCmdStr;
  73. Function GetSanitizerLibName(const basename: TCmdStr; withArch: boolean): TCmdStr;
  74. Function AddSanitizerLibrariesAndGetSearchDir(const platformname: TCmdStr; out sanitizerlibrarydir: TCmdStr): boolean;
  75. public
  76. Info : TLinkerInfo;
  77. Constructor Create;override;
  78. Destructor Destroy;override;
  79. Function FindUtil(const s:TCmdStr;throwerror: boolean=true):TCmdStr;
  80. Function CatFileContent(para:TCmdStr):TCmdStr;
  81. Function DoExec(const command:TCmdStr; para:TCmdStr;showinfo,useshell:boolean):boolean;
  82. procedure SetDefaultInfo;virtual;
  83. Function MakeStaticLibrary:boolean;override;
  84. Function UniqueName(const str:TCmdStr): TCmdStr;
  85. function PostProcessELFExecutable(const fn: string; isdll: boolean): boolean;
  86. function PostProcessMachExecutable(const fn: string; isdll: boolean): boolean;
  87. end;
  88. TBooleanArray = array [1..100000] of boolean;
  89. PBooleanArray = ^TBooleanArray;
  90. TInternalLinker = class(TLinker)
  91. private
  92. FCExeOutput : TExeOutputClass;
  93. FCObjInput : TObjInputClass;
  94. FCArObjectReader : TObjectReaderClass;
  95. { Libraries }
  96. FStaticLibraryList : TFPObjectList;
  97. FImportLibraryList : TFPHashObjectList;
  98. FGroupStack : TFPObjectList;
  99. procedure Load_ReadObject(const para:TCmdStr);
  100. procedure Load_ReadStaticLibrary(const para:TCmdStr;asneededflag:boolean=false);
  101. procedure Load_Group;
  102. procedure Load_EndGroup;
  103. procedure ParseScript_Handle;
  104. procedure ParseScript_PostCheck;
  105. procedure ParseScript_Load;
  106. function ParsePara(const para : string) : string;
  107. procedure ParseScript_Order;
  108. procedure ParseScript_MemPos;
  109. procedure ParseScript_DataPos;
  110. procedure PrintLinkerScript;
  111. function RunLinkScript(const outputname:TCmdStr):boolean;
  112. procedure ParseLdScript(src:TScriptLexer);
  113. protected
  114. linkscript : TCmdStrList;
  115. ScriptCount : longint;
  116. IsHandled : TBooleanDynArray;
  117. property CArObjectReader:TObjectReaderClass read FCArObjectReader write FCArObjectReader;
  118. property CObjInput:TObjInputClass read FCObjInput write FCObjInput;
  119. property CExeOutput:TExeOutputClass read FCExeOutput write FCExeOutput;
  120. property StaticLibraryList:TFPObjectList read FStaticLibraryList;
  121. property ImportLibraryList:TFPHashObjectList read FImportLibraryList;
  122. procedure DefaultLinkScript;virtual;abstract;
  123. procedure ScriptAddGenericSections(secnames:string);
  124. procedure ScriptAddSourceStatements(AddSharedAsStatic:boolean);virtual;
  125. function GetCodeSize(aExeOutput: TExeOutput): QWord;virtual;
  126. function GetDataSize(aExeOutput: TExeOutput): QWord;virtual;
  127. function GetBssSize(aExeOutput: TExeOutput): QWord;virtual;
  128. function ExecutableFilename:String;virtual;
  129. function SharedLibFilename:String;virtual;
  130. public
  131. IsSharedLibrary : boolean;
  132. UseStabs : boolean;
  133. Constructor Create;override;
  134. Destructor Destroy;override;
  135. Function MakeExecutable:boolean;override;
  136. Function MakeSharedLibrary:boolean;override;
  137. procedure AddImportSymbol(const libname,symname,symmangledname:TCmdStr;OrdNr: longint;isvar:boolean);override;
  138. end;
  139. TLinkerClass = class of Tlinker;
  140. var
  141. Linker : TLinker;
  142. function FindObjectFile(s : TCmdStr;const unitpath:TCmdStr;isunit:boolean) : TCmdStr;
  143. function FindLibraryFile(s:TCmdStr;const prefix,ext:TCmdStr;var foundfile : TCmdStr) : boolean;
  144. function FindDLL(const s:TCmdStr;var founddll:TCmdStr):boolean;
  145. procedure RegisterLinker(id:tlink;c:TLinkerClass);
  146. procedure InitLinker;
  147. procedure DoneLinker;
  148. Implementation
  149. uses
  150. cutils,cfileutl,cstreams,
  151. {$ifdef hasUnix}
  152. baseunix,
  153. {$endif hasUnix}
  154. cscript,globals,verbose,comphook,ppu,fpchash,triplet,tripletcpu,
  155. aasmbase,aasmcpu,
  156. ogmap;
  157. var
  158. CLinker : array[tlink] of TLinkerClass;
  159. {*****************************************************************************
  160. Helpers
  161. *****************************************************************************}
  162. function GetFileCRC(const fn:TPathStr):cardinal;
  163. var
  164. fs : TCStream;
  165. bufcount,
  166. bufsize : Integer;
  167. buf : TByteDynArray;
  168. begin
  169. result:=0;
  170. bufsize:=64*1024;
  171. fs:=CFileStreamClass.Create(fn,fmOpenRead or fmShareDenyNone);
  172. if CStreamError<>0 then
  173. begin
  174. fs.Free;
  175. fs := nil;
  176. Comment(V_Error,'Can''t open file: '+fn);
  177. exit;
  178. end;
  179. setlength(buf,bufsize);
  180. repeat
  181. bufcount:=fs.Read(buf[0],bufsize);
  182. result:=UpdateCrc32(result,buf[0],bufcount);
  183. until bufcount<bufsize;
  184. buf:=nil;
  185. fs.Free;
  186. fs := nil;
  187. end;
  188. { searches an object file }
  189. function FindObjectFile(s:TCmdStr;const unitpath:TCmdStr;isunit:boolean) : TCmdStr;
  190. var
  191. found : boolean;
  192. foundfile : TCmdStr;
  193. begin
  194. findobjectfile:='';
  195. if s='' then
  196. exit;
  197. {When linking on target, the units has not been assembled yet,
  198. if assembling is also done on target,
  199. so there is no object files to look for at
  200. the host. Look for the corresponding assembler file instead,
  201. because it will be assembled to object file on the target.}
  202. if isunit and (cs_assemble_on_target in current_settings.globalswitches) then
  203. s:=ChangeFileExt(s,target_info.asmext);
  204. { when it does not belong to the unit then check if
  205. the specified file exists without searching any paths }
  206. if not isunit then
  207. begin
  208. if FileExists(FixFileName(s),false) then
  209. begin
  210. foundfile:=ScriptFixFileName(s);
  211. found:=true;
  212. end;
  213. end;
  214. if pos('.',s)=0 then
  215. s:=s+target_info.objext;
  216. { find object file
  217. 1. output unit path
  218. 2. output exe path
  219. 3. specified unit path (if specified)
  220. 4. cwd
  221. 5. unit search path
  222. 6. local object path
  223. 7. global object path
  224. 8. exepath (not when linking on target)
  225. for all finds don't use the directory caching }
  226. found:=false;
  227. if isunit and (OutputUnitDir<>'') then
  228. found:=FindFile(s,OutPutUnitDir,false,foundfile)
  229. else
  230. if OutputExeDir<>'' then
  231. found:=FindFile(s,OutPutExeDir,false,foundfile);
  232. if (not found) and (unitpath<>'') then
  233. found:=FindFile(s,unitpath,false,foundfile);
  234. if (not found) then
  235. found:=FindFile(s, CurDirRelPath(source_info),false,foundfile);
  236. if (not found) then
  237. found:=UnitSearchPath.FindFile(s,false,foundfile);
  238. if (not found) then
  239. found:=current_module.localobjectsearchpath.FindFile(s,false,foundfile);
  240. if (not found) then
  241. found:=objectsearchpath.FindFile(s,false,foundfile);
  242. if not(cs_link_on_target in current_settings.globalswitches) and (not found) then
  243. found:=FindFile(s,exepath,false,foundfile);
  244. if not(cs_link_nolink in current_settings.globalswitches) and (not found) then
  245. Message1(exec_w_objfile_not_found,s);
  246. {Restore file extension}
  247. if isunit and (cs_assemble_on_target in current_settings.globalswitches) then
  248. foundfile:= ChangeFileExt(foundfile,target_info.objext);
  249. findobjectfile:=ScriptFixFileName(foundfile);
  250. end;
  251. { searches a (windows) DLL file }
  252. function FindDLL(const s:TCmdStr;var founddll:TCmdStr):boolean;
  253. var
  254. sysdir : TCmdStr;
  255. Found : boolean;
  256. begin
  257. Found:=false;
  258. { Look for DLL in:
  259. 1. Current dir
  260. 2. Library Path
  261. 3. windir,windir/system,windir/system32 }
  262. Found:=FindFile(s,'.'+source_info.DirSep,false,founddll);
  263. if (not found) then
  264. Found:=librarysearchpath.FindFile(s,false,founddll);
  265. { when cross compiling, it is pretty useless to search windir etc. for dlls }
  266. if (not found) and (source_info.system=target_info.system) then
  267. begin
  268. sysdir:=FixPath(GetEnvironmentVariable('windir'),false);
  269. Found:=FindFile(s,sysdir+';'+sysdir+'system'+source_info.DirSep+';'+sysdir+'system32'+source_info.DirSep,false,founddll);
  270. end;
  271. if (not found) then
  272. begin
  273. message1(exec_w_libfile_not_found,s);
  274. FoundDll:=s;
  275. end;
  276. FindDll:=Found;
  277. end;
  278. { searches an library file }
  279. function FindLibraryFile(s:TCmdStr;const prefix,ext:TCmdStr;var foundfile : TCmdStr) : boolean;
  280. var
  281. found : boolean;
  282. paths : TCmdStr;
  283. begin
  284. findlibraryfile:=false;
  285. foundfile:=s;
  286. if s='' then
  287. exit;
  288. { split path from filename }
  289. paths:=ExtractFilePath(s);
  290. s:=ExtractFileName(s);
  291. { add prefix 'lib' }
  292. if (prefix<>'') and (Copy(s,1,length(prefix))<>prefix) then
  293. s:=prefix+s;
  294. { add extension }
  295. if (ext<>'') and (Copy(s,length(s)-length(ext)+1,length(ext))<>ext) then
  296. s:=s+ext;
  297. { readd the split path }
  298. s:=paths+s;
  299. if FileExists(s,false) then
  300. begin
  301. foundfile:=ScriptFixFileName(s);
  302. FindLibraryFile:=true;
  303. exit;
  304. end;
  305. { find libary
  306. 1. cwd
  307. 2. local libary dir
  308. 3. global libary dir
  309. 4. exe path of the compiler (not when linking on target)
  310. for all searches don't use the directory cache }
  311. found:=FindFile(s, CurDirRelPath(source_info), false,foundfile);
  312. if (not found) and (current_module.outputpath<>'') then
  313. found:=FindFile(s,current_module.outputpath,false,foundfile);
  314. if (not found) then
  315. found:=current_module.locallibrarysearchpath.FindFile(s,false,foundfile);
  316. if (not found) then
  317. found:=librarysearchpath.FindFile(s,false,foundfile);
  318. if not(cs_link_on_target in current_settings.globalswitches) and (not found) then
  319. found:=FindFile(s,exepath,false,foundfile);
  320. foundfile:=ScriptFixFileName(foundfile);
  321. findlibraryfile:=found;
  322. end;
  323. {*****************************************************************************
  324. TLINKER
  325. *****************************************************************************}
  326. Constructor TLinker.Create;
  327. begin
  328. Inherited Create;
  329. ObjectFiles:=TCmdStrList.Create_no_double;
  330. SharedLibFiles:=TCmdStrList.Create_no_double;
  331. StaticLibFiles:=TCmdStrList.Create_no_double;
  332. FrameworkFiles:=TCmdStrList.Create_no_double;
  333. OrderedSymbols:=TCmdStrList.Create;
  334. end;
  335. Destructor TLinker.Destroy;
  336. begin
  337. ObjectFiles.Free;
  338. ObjectFiles := nil;
  339. SharedLibFiles.Free;
  340. SharedLibFiles := nil;
  341. StaticLibFiles.Free;
  342. StaticLibFiles := nil;
  343. FrameworkFiles.Free;
  344. FrameworkFiles := nil;
  345. OrderedSymbols.Free;
  346. OrderedSymbols := nil;
  347. inherited;
  348. end;
  349. procedure TLinker.AddModuleFiles(hp:tmodule);
  350. var
  351. mask : longint;
  352. i,j : longint;
  353. ImportLibrary : TImportLibrary;
  354. ImportSymbol : TImportSymbol;
  355. begin
  356. with hp do
  357. begin
  358. if mf_has_resourcefiles in moduleflags then
  359. HasResources:=true;
  360. if mf_has_exports in moduleflags then
  361. HasExports:=true;
  362. { link unit files }
  363. if (headerflags and uf_no_link)=0 then
  364. begin
  365. { create mask which unit files need linking }
  366. mask:=link_always;
  367. { lto linking ?}
  368. if (cs_lto in current_settings.moduleswitches) and
  369. ((headerflags and uf_lto_linked)<>0) and
  370. (not(cs_lto_nosystem in init_settings.globalswitches) or
  371. (hp.modulename^<>'SYSTEM')) then
  372. begin
  373. mask:=mask or link_lto;
  374. end
  375. else
  376. begin
  377. { static linking ? }
  378. if (cs_link_static in current_settings.globalswitches) then
  379. begin
  380. if (headerflags and uf_static_linked)=0 then
  381. begin
  382. { if static not avail then try smart linking }
  383. if (headerflags and uf_smart_linked)<>0 then
  384. begin
  385. Message1(exec_t_unit_not_static_linkable_switch_to_smart,modulename^);
  386. mask:=mask or link_smart;
  387. end
  388. else
  389. Message1(exec_e_unit_not_smart_or_static_linkable,modulename^);
  390. end
  391. else
  392. mask:=mask or link_static;
  393. end;
  394. { smart linking ? }
  395. if (cs_link_smart in current_settings.globalswitches) then
  396. begin
  397. if (headerflags and uf_smart_linked)=0 then
  398. begin
  399. { if smart not avail then try static linking }
  400. if (headerflags and uf_static_linked)<>0 then
  401. begin
  402. { if not create_smartlink_library, then smart linking happens using the
  403. regular object files
  404. }
  405. if create_smartlink_library then
  406. Message1(exec_t_unit_not_smart_linkable_switch_to_static,modulename^);
  407. mask:=mask or link_static;
  408. end
  409. else
  410. Message1(exec_e_unit_not_smart_or_static_linkable,modulename^);
  411. end
  412. else
  413. mask:=mask or link_smart;
  414. end;
  415. { shared linking }
  416. if (cs_link_shared in current_settings.globalswitches) then
  417. begin
  418. if (headerflags and uf_shared_linked)=0 then
  419. begin
  420. { if shared not avail then try static linking }
  421. if (headerflags and uf_static_linked)<>0 then
  422. begin
  423. Message1(exec_t_unit_not_shared_linkable_switch_to_static,modulename^);
  424. mask:=mask or link_static;
  425. end
  426. else
  427. Message1(exec_e_unit_not_shared_or_static_linkable,modulename^);
  428. end
  429. else
  430. mask:=mask or link_shared;
  431. end;
  432. end;
  433. { unit files }
  434. while not linkunitofiles.empty do
  435. AddObject(linkunitofiles.getusemask(mask),path,true);
  436. while not linkunitstaticlibs.empty do
  437. AddStaticLibrary(linkunitstaticlibs.getusemask(mask));
  438. while not linkunitsharedlibs.empty do
  439. AddSharedLibrary(linkunitsharedlibs.getusemask(mask));
  440. end;
  441. { Other needed .o and libs, specified using $L,$LINKLIB,external }
  442. mask:=link_always;
  443. while not linkotherofiles.empty do
  444. AddObject(linkotherofiles.Getusemask(mask),path,false);
  445. while not linkotherstaticlibs.empty do
  446. AddStaticCLibrary(linkotherstaticlibs.Getusemask(mask));
  447. while not linkothersharedlibs.empty do
  448. AddSharedCLibrary(linkothersharedlibs.Getusemask(mask));
  449. while not linkotherframeworks.empty do
  450. AddFramework(linkotherframeworks.Getusemask(mask));
  451. { Known Library/DLL Imports }
  452. for i:=0 to ImportLibraryList.Count-1 do
  453. begin
  454. ImportLibrary:=TImportLibrary(ImportLibraryList[i]);
  455. for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do
  456. begin
  457. ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
  458. AddImportSymbol(ImportLibrary.Name,ImportSymbol.Name,
  459. ImportSymbol.MangledName,ImportSymbol.OrdNr,ImportSymbol.IsVar);
  460. end;
  461. end;
  462. { ordered symbols }
  463. OrderedSymbols.concatList(linkorderedsymbols);
  464. end;
  465. end;
  466. procedure TLinker.AddImportSymbol(const libname,symname,symmangledname:TCmdStr;OrdNr: longint;isvar:boolean);
  467. begin
  468. end;
  469. Procedure TLinker.AddObject(const S,unitpath : TPathStr;isunit:boolean);
  470. begin
  471. ObjectFiles.Concat(FindObjectFile(s,unitpath,isunit))
  472. end;
  473. Procedure TLinker.AddSharedLibrary(S:TCmdStr);
  474. begin
  475. if s='' then
  476. exit;
  477. { remove prefix 'lib' }
  478. if Copy(s,1,length(target_info.sharedlibprefix))=target_info.sharedlibprefix then
  479. Delete(s,1,length(target_info.sharedlibprefix));
  480. { remove extension if any }
  481. if Copy(s,length(s)-length(target_info.sharedlibext)+1,length(target_info.sharedlibext))=target_info.sharedlibext then
  482. Delete(s,length(s)-length(target_info.sharedlibext)+1,length(target_info.sharedlibext)+1);
  483. { ready to be added }
  484. SharedLibFiles.Concat(S);
  485. end;
  486. Procedure TLinker.AddStaticLibrary(const S:TCmdStr);
  487. var
  488. ns : TCmdStr;
  489. found : boolean;
  490. begin
  491. if s='' then
  492. exit;
  493. found:=FindLibraryFile(s,target_info.staticlibprefix,target_info.staticlibext,ns);
  494. if not(cs_link_nolink in current_settings.globalswitches) and (not found) then
  495. Message1(exec_w_libfile_not_found,s);
  496. StaticLibFiles.Concat(ns);
  497. end;
  498. Procedure TLinker.AddSharedCLibrary(S:TCmdStr);
  499. begin
  500. if s='' then
  501. exit;
  502. { remove prefix 'lib' }
  503. if Copy(s,1,length(target_info.sharedclibprefix))=target_info.sharedclibprefix then
  504. Delete(s,1,length(target_info.sharedclibprefix));
  505. { remove extension if any }
  506. if Copy(s,length(s)-length(target_info.sharedclibext)+1,length(target_info.sharedclibext))=target_info.sharedclibext then
  507. Delete(s,length(s)-length(target_info.sharedclibext)+1,length(target_info.sharedclibext)+1);
  508. { ready to be added }
  509. SharedLibFiles.Concat(S);
  510. end;
  511. Procedure TLinker.AddFramework(S:TCmdStr);
  512. begin
  513. if s='' then
  514. exit;
  515. { ready to be added }
  516. FrameworkFiles.Concat(S);
  517. end;
  518. procedure TLinker.AddOrderedSymbol(const s: TCmdStr);
  519. begin
  520. OrderedSymbols.Concat(s);
  521. end;
  522. Procedure TLinker.AddStaticCLibrary(const S:TCmdStr);
  523. var
  524. ns : TCmdStr;
  525. found : boolean;
  526. begin
  527. if s='' then
  528. exit;
  529. found:=FindLibraryFile(s,target_info.staticclibprefix,target_info.staticclibext,ns);
  530. if not(cs_link_nolink in current_settings.globalswitches) and (not found) then
  531. Message1(exec_w_libfile_not_found,s);
  532. StaticLibFiles.Concat(ns);
  533. end;
  534. procedure TLinker.InitSysInitUnitName;
  535. begin
  536. end;
  537. function TLinker.MakeExecutable:boolean;
  538. begin
  539. MakeExecutable:=false;
  540. Message(exec_e_exe_not_supported);
  541. end;
  542. Function TLinker.MakeSharedLibrary:boolean;
  543. begin
  544. MakeSharedLibrary:=false;
  545. Message(exec_e_dll_not_supported);
  546. end;
  547. Function TLinker.MakeStaticLibrary:boolean;
  548. begin
  549. MakeStaticLibrary:=false;
  550. Message(exec_e_static_lib_not_supported);
  551. end;
  552. Procedure TLinker.ExpandAndApplyOrder(var Src:TCmdStrList);
  553. var
  554. p : TLinkStrMap;
  555. i : longint;
  556. begin
  557. // call Virtual TLinker method to initialize
  558. LoadPredefinedLibraryOrder;
  559. // something to do?
  560. if (LinkLibraryAliases.count=0) and (LinkLibraryOrder.Count=0) Then
  561. exit;
  562. p:=TLinkStrMap.Create;
  563. // expand libaliases, clears src
  564. LinkLibraryAliases.expand(src,p);
  565. // writeln(src.count,' ',p.count,' ',linklibraryorder.count,' ',linklibraryaliases.count);
  566. // apply order
  567. p.UpdateWeights(LinkLibraryOrder);
  568. p.SortOnWeight;
  569. // put back in src
  570. for i:=0 to p.count-1 do
  571. src.insert(p[i].Key);
  572. p.free;
  573. p := nil;
  574. end;
  575. procedure TLinker.LoadPredefinedLibraryOrder;
  576. begin
  577. end;
  578. function TLinker.ReOrderEntries : boolean;
  579. begin
  580. result:=(LinkLibraryOrder.count>0) or (LinkLibraryAliases.count>0);
  581. end;
  582. {*****************************************************************************
  583. TEXTERNALLINKER
  584. *****************************************************************************}
  585. Function TExternalLinker.WriteSymbolOrderFile: TCmdStr;
  586. var
  587. item: TCmdStrListItem;
  588. symfile: TScript;
  589. begin
  590. result:='';
  591. { only for darwin for now; can also enable for other platforms when using
  592. the LLVM linker }
  593. if (OrderedSymbols.Empty) or
  594. not(tf_supports_symbolorderfile in target_info.flags) then
  595. exit;
  596. symfile:=TScript.Create(outputexedir+UniqueName('symbol_order')+'.fpc');
  597. item:=TCmdStrListItem(OrderedSymbols.First);
  598. while assigned(item) do
  599. begin
  600. symfile.add(item.str);
  601. item:=TCmdStrListItem(item.next);
  602. end;
  603. symfile.WriteToDisk;
  604. result:=symfile.fn;
  605. symfile.Free;
  606. symfile := nil;
  607. end;
  608. Function TExternalLinker.GetSanitizerLibName(const basename: TCmdStr; withArch: boolean): TCmdStr;
  609. begin
  610. result:=target_info.sharedClibprefix+'clang_rt.'+basename;
  611. if target_info.system in systems_darwin then
  612. begin
  613. { Darwin never adds the arch, it uses fat binaries. But it has the
  614. extra '_dynamic' for some reason, and also adds the platform type
  615. }
  616. if target_info.system in systems_macosx then
  617. result:=result+'_osx_dynamic'
  618. else if target_info.system in systems_ios then
  619. result:='_ios_dynamic'
  620. else if target_info.system in systems_iphonesim then
  621. result:='_iossim_dynamic'
  622. else
  623. internalerror(2022071010);
  624. end
  625. else
  626. begin
  627. if withArch then
  628. begin
  629. result:=result+'-'+tripletcpustr(triplet_llvmrt);
  630. if target_info.system in systems_android then
  631. result:=result+'-android';
  632. end;
  633. end;
  634. result:=result+target_info.sharedClibext;
  635. end;
  636. function TExternalLinker.AddSanitizerLibrariesAndGetSearchDir(const platformname: TCmdStr; out sanitizerlibrarydir: TCmdStr): boolean;
  637. var
  638. clang,
  639. clangsearchdirs,
  640. textline,
  641. clangsearchdirspath,
  642. sanitizerlibname,
  643. sanitizerlibrarypath: TCmdStr;
  644. sanitizerlibraryfiles: TCmdStrList;
  645. searchrec: TSearchRec;
  646. searchres: longint;
  647. clangsearchdirsfile: text;
  648. begin
  649. sanitizerlibraryfiles:=TCmdStrList.Create;
  650. result:=false;
  651. if (cs_sanitize_address in current_settings.moduleswitches) and
  652. not(cs_link_on_target in current_settings.globalswitches) then
  653. begin
  654. { ask clang }
  655. clang:=FindUtil('clang'+llvmutilssuffix);
  656. if clang<>'' then
  657. begin
  658. clangsearchdirspath:=outputexedir+UniqueName('clangsearchdirs');
  659. searchres:=shell(maybequoted(clang)+' -target '+targettriplet(triplet_llvm)+' -print-file-name=lib > '+maybequoted(clangsearchdirspath));
  660. if searchres=0 then
  661. begin
  662. AssignFile(clangsearchdirsfile,clangsearchdirspath);
  663. {$push}{$i-}
  664. reset(clangsearchdirsfile);
  665. {$pop}
  666. if ioresult=0 then
  667. begin
  668. readln(clangsearchdirsfile,textline);
  669. sanitizerlibrarydir:=FixFileName(textline+'/'+platformname);
  670. sanitizerlibrarypath:=FixFileName(sanitizerlibrarydir+'/');
  671. { from clang:
  672. Check for runtime files in the new layout without the architecture first.
  673. }
  674. sanitizerlibname:=GetSanitizerLibName('asan',false);
  675. result:=FileExists(sanitizerlibrarypath+sanitizerlibname,false);
  676. if result then
  677. begin
  678. sanitizerlibraryfiles.Concat(sanitizerlibrarypath+sanitizerlibname);
  679. end
  680. else
  681. begin
  682. sanitizerlibname:=GetSanitizerLibName('asan',true);
  683. result:=FileExists(sanitizerlibrarypath+sanitizerlibname,false);
  684. if result then
  685. sanitizerlibraryfiles.Concat(sanitizerlibrarypath+sanitizerlibname);
  686. end;
  687. end;
  688. end;
  689. if FileExists(clangsearchdirspath,false) then
  690. DeleteFile(clangsearchdirspath);
  691. end;
  692. end;
  693. if result then
  694. ObjectFiles.concatList(sanitizerlibraryfiles);
  695. sanitizerlibraryfiles.free;
  696. sanitizerlibraryfiles := nil;
  697. end;
  698. Constructor TExternalLinker.Create;
  699. begin
  700. inherited Create;
  701. { set generic defaults }
  702. FillChar(Info,sizeof(Info),0);
  703. if cs_link_on_target in current_settings.globalswitches then
  704. begin
  705. Info.ResName:=ChangeFileExt(inputfilename,'_link.res');
  706. Info.ScriptName:=ChangeFileExt(inputfilename,'_script.res');
  707. end
  708. else
  709. begin
  710. Info.ResName:=UniqueName('link')+'.res';
  711. Info.ScriptName:=UniqueName('script')+'.res';
  712. end;
  713. { set the linker specific defaults }
  714. SetDefaultInfo;
  715. { Allow Parameter overrides for linker info }
  716. with Info do
  717. begin
  718. if ParaLinkOptions<>'' then
  719. ExtraOptions:=ParaLinkOptions;
  720. if ParaDynamicLinker<>'' then
  721. DynamicLinker:=ParaDynamicLinker;
  722. end;
  723. end;
  724. Destructor TExternalLinker.Destroy;
  725. begin
  726. inherited destroy;
  727. end;
  728. Procedure TExternalLinker.SetDefaultInfo;
  729. begin
  730. end;
  731. Function TExternalLinker.FindUtil(const s:TCmdStr;throwerror: boolean=true):TCmdStr;
  732. var
  733. Found : boolean;
  734. FoundBin : TCmdStr;
  735. UtilExe : TCmdStr;
  736. begin
  737. if cs_link_on_target in current_settings.globalswitches then
  738. begin
  739. { If linking on target, don't add any path PM }
  740. { change extension only on platforms that use an exe extension, otherwise on OpenBSD 'ld.bfd' gets
  741. converted to 'ld' }
  742. if target_info.exeext<>'' then
  743. FindUtil:=ChangeFileExt(s,target_info.exeext)
  744. else
  745. FindUtil:=s;
  746. exit;
  747. end;
  748. { change extension only on platforms that use an exe extension, otherwise on OpenBSD 'ld.bfd' gets converted
  749. to 'ld' }
  750. if source_info.exeext<>'' then
  751. UtilExe:=ChangeFileExt(s,source_info.exeext)
  752. else
  753. UtilExe:=s;
  754. FoundBin:='';
  755. Found:=false;
  756. if utilsdirectory<>'' then
  757. Found:=FindFile(utilexe,utilsdirectory,false,Foundbin);
  758. if (not Found) then
  759. Found:=FindExe(utilexe,false,Foundbin);
  760. if throwerror and (not Found) and not(cs_link_nolink in current_settings.globalswitches) then
  761. begin
  762. Message1(exec_e_util_not_found,utilexe);
  763. current_settings.globalswitches:=current_settings.globalswitches+[cs_link_nolink];
  764. end;
  765. if (FoundBin<>'') then
  766. Message1(exec_t_using_util,FoundBin);
  767. FindUtil:=FoundBin;
  768. end;
  769. Function TExternalLinker.CatFileContent(para : TCmdStr) : TCmdStr;
  770. var
  771. filecontent : TCmdStr;
  772. f : text;
  773. st : TCmdStr;
  774. begin
  775. if not (tf_no_backquote_support in source_info.flags) or
  776. (cs_link_on_target in current_settings.globalswitches) then
  777. begin
  778. CatFileContent:='`cat '+MaybeQuoted(para)+'`';
  779. Exit;
  780. end;
  781. assign(f,para);
  782. filecontent:='';
  783. {$push}{$I-}
  784. reset(f);
  785. {$pop}
  786. if IOResult<>0 then
  787. begin
  788. Message1(exec_n_backquote_cat_file_not_found,para);
  789. end
  790. else
  791. begin
  792. while not eof(f) do
  793. begin
  794. readln(f,st);
  795. if st<>'' then
  796. filecontent:=filecontent+' '+st;
  797. end;
  798. close(f);
  799. end;
  800. CatFileContent:=filecontent;
  801. end;
  802. Function TExternalLinker.DoExec(const command:TCmdStr; para:TCmdStr;showinfo,useshell:boolean):boolean;
  803. var
  804. exitcode: longint;
  805. begin
  806. DoExec:=true;
  807. if not(cs_link_nolink in current_settings.globalswitches) then
  808. begin
  809. FlushOutput;
  810. if useshell then
  811. exitcode:=shell(maybequoted(command)+' '+para)
  812. else
  813. try
  814. exitcode:=RequotedExecuteProcess(command,para);
  815. except on E:EOSError do
  816. begin
  817. Message1(exec_e_cant_call_linker,e.Message);
  818. current_settings.globalswitches:=current_settings.globalswitches+[cs_link_nolink];
  819. DoExec:=false;
  820. end;
  821. end;
  822. if (exitcode<>0) then
  823. begin
  824. Message(exec_e_error_while_linking);
  825. current_settings.globalswitches:=current_settings.globalswitches+[cs_link_nolink];
  826. DoExec:=false;
  827. end;
  828. end;
  829. { Update asmres when externmode is set }
  830. if cs_link_nolink in current_settings.globalswitches then
  831. begin
  832. if showinfo then
  833. begin
  834. if current_module.islibrary then
  835. AsmRes.AddLinkCommand(Command,Para,current_module.sharedlibfilename)
  836. else
  837. AsmRes.AddLinkCommand(Command,Para,current_module.exefilename);
  838. end
  839. else
  840. AsmRes.AddLinkCommand(Command,Para,'');
  841. end;
  842. end;
  843. Function TExternalLinker.MakeStaticLibrary:boolean;
  844. var
  845. total_size, power : longint;
  846. function GetNextFiles(const maxCmdLength : Longint; var item : TCmdStrListItem; const addfilecmd : string) : TCmdStr;
  847. var
  848. ItemExists : boolean;
  849. ItemSize : longint;
  850. fs : file;
  851. begin
  852. result := '';
  853. while (assigned(item) and ((length(result) + length(item.str) + 1) < maxCmdLength)) do begin
  854. ItemExists:=FileExists(FixFilename(item.str),true);
  855. ItemSize:=0;
  856. if ItemExists then
  857. begin
  858. system.assign(fs,item.str);
  859. system.reset(fs);
  860. ItemSize:=FileSize(fs);
  861. system.close(fs);
  862. system.inc(total_size,align(ItemSize,16));
  863. end;
  864. if (cs_link_nolink in current_settings.globalswitches) or
  865. (ItemExists and (ItemSize>0)) then
  866. result := result + ' ' + addfilecmd + item.str;
  867. item := TCmdStrListItem(item.next);
  868. end;
  869. end;
  870. function get_wlib_record_size: integer;
  871. var
  872. nb_pages,page_size : longint;
  873. begin
  874. { Set wlib page size to a sensible value }
  875. if total_size>0 then
  876. begin
  877. page_size:=16 div 2;
  878. repeat
  879. page_size:=page_size*2;
  880. nb_pages:=(total_size + (page_size-1)*SmartLinkOFiles.count) div page_size;
  881. until nb_pages <= high(word);
  882. result:=nb_pages;
  883. end
  884. else
  885. result:=max(16,nextpowerof2(SmartLinkOFiles.count div 16, power));
  886. end;
  887. var
  888. binstr, firstbinstr, scriptfile : TCmdStr;
  889. cmdstr, firstcmd, nextcmd, smartpath : TCmdStr;
  890. current : TCmdStrListItem;
  891. script: Text;
  892. scripted_ar : boolean;
  893. ar_creates_different_output_file : boolean;
  894. success : boolean;
  895. first : boolean;
  896. begin
  897. MakeStaticLibrary:=false;
  898. total_size:=0;
  899. { remove the library, to be sure that it is rewritten }
  900. DeleteFile(current_module.staticlibfilename);
  901. { Call AR }
  902. smartpath:=FixPath(ChangeFileExt(current_module.asmfilename,target_info.smartext),false);
  903. SplitBinCmd(target_ar.arcmd,binstr,cmdstr);
  904. binstr := FindUtil(utilsprefix + binstr);
  905. if target_ar.arfirstcmd<>'' then
  906. begin
  907. SplitBinCmd(target_ar.arfirstcmd,firstbinstr,firstcmd);
  908. firstbinstr := FindUtil(utilsprefix + firstbinstr);
  909. end
  910. else
  911. begin
  912. firstbinstr:=binstr;
  913. firstcmd:=cmdstr;
  914. end;
  915. scripted_ar:=(target_ar.id=ar_gnu_ar_scripted) or
  916. (target_ar.id=ar_watcom_wlib_omf_scripted) or
  917. (target_ar.id=ar_sdcc_sdar_scripted);
  918. if scripted_ar then
  919. begin
  920. scriptfile := FixFileName(smartpath+'arscript.txt');
  921. Replace(cmdstr,'$SCRIPT',maybequoted(scriptfile));
  922. Assign(script, scriptfile);
  923. Rewrite(script);
  924. try
  925. if (target_ar.id in [ar_gnu_ar_scripted,ar_sdcc_sdar_scripted]) then
  926. writeln(script, 'CREATE ' + current_module.staticlibfilename)
  927. else { wlib case }
  928. writeln(script,'-q -p=',get_wlib_record_size,' -fo -c -b '+
  929. maybequoted(current_module.staticlibfilename));
  930. current := TCmdStrListItem(SmartLinkOFiles.First);
  931. while current <> nil do
  932. begin
  933. if (target_ar.id in [ar_gnu_ar_scripted,ar_sdcc_sdar_scripted]) then
  934. writeln(script, 'ADDMOD ' + current.str)
  935. else
  936. writeln(script,'+' + current.str);
  937. current := TCmdStrListItem(current.next);
  938. end;
  939. if (target_ar.id in [ar_gnu_ar_scripted,ar_sdcc_sdar_scripted]) then
  940. begin
  941. writeln(script, 'SAVE');
  942. writeln(script, 'END');
  943. end;
  944. finally
  945. Close(script);
  946. end;
  947. success:=DoExec(binstr,cmdstr,false,true);
  948. end
  949. else
  950. begin
  951. ar_creates_different_output_file:=(Pos('$OUTPUTLIB',cmdstr)>0) or (Pos('$OUTPUTLIB',firstcmd)>0);
  952. Replace(cmdstr,'$LIB',maybequoted(current_module.staticlibfilename));
  953. Replace(firstcmd,'$LIB',maybequoted(current_module.staticlibfilename));
  954. Replace(cmdstr,'$OUTPUTLIB',maybequoted(current_module.staticlibfilename+'.tmp'));
  955. Replace(firstcmd,'$OUTPUTLIB',maybequoted(current_module.staticlibfilename+'.tmp'));
  956. if target_ar.id=ar_watcom_wlib_omf then
  957. begin
  958. Replace(cmdstr,'$RECSIZE','-p='+IntToStr(get_wlib_record_size));
  959. Replace(firstcmd,'$RECSIZE','-p='+IntToStr(get_wlib_record_size));
  960. end;
  961. { create AR commands }
  962. success := true;
  963. current := TCmdStrListItem(SmartLinkOFiles.First);
  964. first := true;
  965. repeat
  966. if first then
  967. nextcmd := firstcmd
  968. else
  969. nextcmd := cmdstr;
  970. Replace(nextcmd,'$FILES',GetNextFiles(2047, current, target_ar.addfilecmd));
  971. if first then
  972. success:=DoExec(firstbinstr,nextcmd,false,true)
  973. else
  974. success:=DoExec(binstr,nextcmd,false,true);
  975. if ar_creates_different_output_file then
  976. begin
  977. if FileExists(current_module.staticlibfilename,false) then
  978. DeleteFile(current_module.staticlibfilename);
  979. if FileExists(current_module.staticlibfilename+'.tmp',false) then
  980. RenameFile(current_module.staticlibfilename+'.tmp',current_module.staticlibfilename);
  981. end;
  982. first := false;
  983. until (not assigned(current)) or (not success);
  984. end;
  985. if (target_ar.arfinishcmd <> '') then
  986. begin
  987. SplitBinCmd(target_ar.arfinishcmd,binstr,cmdstr);
  988. binstr := FindUtil(utilsprefix + binstr);
  989. Replace(cmdstr,'$LIB',maybequoted(current_module.staticlibfilename));
  990. success:=DoExec(binstr,cmdstr,false,true);
  991. end;
  992. { Clean up }
  993. if not(cs_asm_leave in current_settings.globalswitches) then
  994. if not(cs_link_nolink in current_settings.globalswitches) then
  995. begin
  996. while not SmartLinkOFiles.Empty do
  997. DeleteFile(SmartLinkOFiles.GetFirst);
  998. if scripted_ar then
  999. DeleteFile(scriptfile);
  1000. RemoveDir(smartpath);
  1001. end
  1002. else
  1003. begin
  1004. while not SmartLinkOFiles.Empty do
  1005. AsmRes.AddDeleteCommand(SmartLinkOFiles.GetFirst);
  1006. if scripted_ar then
  1007. AsmRes.AddDeleteCommand(scriptfile);
  1008. AsmRes.AddDeleteDirCommand(smartpath);
  1009. end;
  1010. MakeStaticLibrary:=success;
  1011. end;
  1012. function TExternalLinker.UniqueName(const str: TCmdStr): TCmdStr;
  1013. const
  1014. pid: SizeUInt = 0;
  1015. begin
  1016. if pid=0 then
  1017. pid:=GetProcessID;
  1018. if pid>0 then
  1019. result:=str+tostr(pid)
  1020. else
  1021. result:=str;
  1022. end;
  1023. function TExternalLinker.PostProcessELFExecutable(const fn : string;isdll:boolean):boolean;
  1024. type
  1025. TElf32header=packed record
  1026. magic0123 : array[0..3] of char;
  1027. file_class : byte;
  1028. data_encoding : byte;
  1029. file_version : byte;
  1030. padding : array[$07..$0f] of byte;
  1031. e_type : word;
  1032. e_machine : word;
  1033. e_version : longint;
  1034. e_entry : longint; { entrypoint }
  1035. e_phoff : longint; { program header offset }
  1036. e_shoff : longint; { sections header offset }
  1037. e_flags : longint;
  1038. e_ehsize : word; { elf header size in bytes }
  1039. e_phentsize : word; { size of an entry in the program header array }
  1040. e_phnum : word; { 0..e_phnum-1 of entrys }
  1041. e_shentsize : word; { size of an entry in sections header array }
  1042. e_shnum : word; { 0..e_shnum-1 of entrys }
  1043. e_shstrndx : word; { index of string section header }
  1044. end;
  1045. TElf32sechdr=packed record
  1046. sh_name : longint;
  1047. sh_type : longint;
  1048. sh_flags : longint;
  1049. sh_addr : longint;
  1050. sh_offset : longint;
  1051. sh_size : longint;
  1052. sh_link : longint;
  1053. sh_info : longint;
  1054. sh_addralign : longint;
  1055. sh_entsize : longint;
  1056. end;
  1057. telf64header=packed record
  1058. magic0123 : array[0..3] of char;
  1059. file_class : byte;
  1060. data_encoding : byte;
  1061. file_version : byte;
  1062. padding : array[$07..$0f] of byte;
  1063. e_type : word;
  1064. e_machine : word;
  1065. e_version : longword;
  1066. e_entry : qword; { entrypoint }
  1067. e_phoff : qword; { program header offset }
  1068. e_shoff : qword; { sections header offset }
  1069. e_flags : longword;
  1070. e_ehsize : word; { elf header size in bytes }
  1071. e_phentsize : word; { size of an entry in the program header array }
  1072. e_phnum : word; { 0..e_phnum-1 of entrys }
  1073. e_shentsize : word; { size of an entry in sections header array }
  1074. e_shnum : word; { 0..e_shnum-1 of entrys }
  1075. e_shstrndx : word; { index of string section header }
  1076. end;
  1077. TElf64sechdr=packed record
  1078. sh_name : longword;
  1079. sh_type : longword;
  1080. sh_flags : qword;
  1081. sh_addr : qword;
  1082. sh_offset : qword;
  1083. sh_size : qword;
  1084. sh_link : longword;
  1085. sh_info : longword;
  1086. sh_addralign : qword;
  1087. sh_entsize : qword;
  1088. end;
  1089. function MayBeSwapHeader(h : telf32header) : telf32header;
  1090. begin
  1091. result:=h;
  1092. if source_info.endian<>target_info.endian then
  1093. with h do
  1094. begin
  1095. result.e_type:=swapendian(e_type);
  1096. result.e_machine:=swapendian(e_machine);
  1097. result.e_version:=swapendian(e_version);
  1098. result.e_entry:=swapendian(e_entry);
  1099. result.e_phoff:=swapendian(e_phoff);
  1100. result.e_shoff:=swapendian(e_shoff);
  1101. result.e_flags:=swapendian(e_flags);
  1102. result.e_ehsize:=swapendian(e_ehsize);
  1103. result.e_phentsize:=swapendian(e_phentsize);
  1104. result.e_phnum:=swapendian(e_phnum);
  1105. result.e_shentsize:=swapendian(e_shentsize);
  1106. result.e_shnum:=swapendian(e_shnum);
  1107. result.e_shstrndx:=swapendian(e_shstrndx);
  1108. end;
  1109. end;
  1110. function MayBeSwapHeader(h : telf64header) : telf64header;
  1111. begin
  1112. result:=h;
  1113. if source_info.endian<>target_info.endian then
  1114. with h do
  1115. begin
  1116. result.e_type:=swapendian(e_type);
  1117. result.e_machine:=swapendian(e_machine);
  1118. result.e_version:=swapendian(e_version);
  1119. result.e_entry:=swapendian(e_entry);
  1120. result.e_phoff:=swapendian(e_phoff);
  1121. result.e_shoff:=swapendian(e_shoff);
  1122. result.e_flags:=swapendian(e_flags);
  1123. result.e_ehsize:=swapendian(e_ehsize);
  1124. result.e_phentsize:=swapendian(e_phentsize);
  1125. result.e_phnum:=swapendian(e_phnum);
  1126. result.e_shentsize:=swapendian(e_shentsize);
  1127. result.e_shnum:=swapendian(e_shnum);
  1128. result.e_shstrndx:=swapendian(e_shstrndx);
  1129. end;
  1130. end;
  1131. function MaybeSwapSecHeader(h : telf32sechdr) : telf32sechdr;
  1132. begin
  1133. result:=h;
  1134. if source_info.endian<>target_info.endian then
  1135. with h do
  1136. begin
  1137. result.sh_name:=swapendian(sh_name);
  1138. result.sh_type:=swapendian(sh_type);
  1139. result.sh_flags:=swapendian(sh_flags);
  1140. result.sh_addr:=swapendian(sh_addr);
  1141. result.sh_offset:=swapendian(sh_offset);
  1142. result.sh_size:=swapendian(sh_size);
  1143. result.sh_link:=swapendian(sh_link);
  1144. result.sh_info:=swapendian(sh_info);
  1145. result.sh_addralign:=swapendian(sh_addralign);
  1146. result.sh_entsize:=swapendian(sh_entsize);
  1147. end;
  1148. end;
  1149. function MaybeSwapSecHeader(h : telf64sechdr) : telf64sechdr;
  1150. begin
  1151. result:=h;
  1152. if source_info.endian<>target_info.endian then
  1153. with h do
  1154. begin
  1155. result.sh_name:=swapendian(sh_name);
  1156. result.sh_type:=swapendian(sh_type);
  1157. result.sh_flags:=swapendian(sh_flags);
  1158. result.sh_addr:=swapendian(sh_addr);
  1159. result.sh_offset:=swapendian(sh_offset);
  1160. result.sh_size:=swapendian(sh_size);
  1161. result.sh_link:=swapendian(sh_link);
  1162. result.sh_info:=swapendian(sh_info);
  1163. result.sh_addralign:=swapendian(sh_addralign);
  1164. result.sh_entsize:=swapendian(sh_entsize);
  1165. end;
  1166. end;
  1167. var
  1168. f : file;
  1169. function ReadSectionName(pos : longint) : String;
  1170. var
  1171. oldpos : longint;
  1172. c : char;
  1173. begin
  1174. oldpos:=filepos(f);
  1175. seek(f,pos);
  1176. Result:='';
  1177. while true do
  1178. begin
  1179. blockread(f,c,1);
  1180. if c=#0 then
  1181. break;
  1182. Result:=Result+c;
  1183. end;
  1184. seek(f,oldpos);
  1185. end;
  1186. var
  1187. elfheader32 : TElf32header;
  1188. secheader32 : TElf32sechdr;
  1189. elfheader64 : TElf64header;
  1190. secheader64 : TElf64sechdr;
  1191. i : longint;
  1192. stringoffset : longint;
  1193. secname : string;
  1194. begin
  1195. Result:=false;
  1196. { open file }
  1197. assign(f,fn);
  1198. {$push}{$I-}
  1199. reset(f,1);
  1200. if ioresult<>0 then
  1201. Message1(execinfo_f_cant_open_executable,fn);
  1202. { read header }
  1203. blockread(f,elfheader32,sizeof(tElf32header));
  1204. with elfheader32 do
  1205. if not((magic0123[0]=#$7f) and (magic0123[1]='E') and (magic0123[2]='L') and (magic0123[3]='F')) then
  1206. Exit;
  1207. case elfheader32.file_class of
  1208. 1:
  1209. begin
  1210. elfheader32:=MayBeSwapHeader(elfheader32);
  1211. seek(f,elfheader32.e_shoff);
  1212. { read string section header }
  1213. seek(f,elfheader32.e_shoff+sizeof(TElf32sechdr)*elfheader32.e_shstrndx);
  1214. blockread(f,secheader32,sizeof(secheader32));
  1215. secheader32:=MaybeSwapSecHeader(secheader32);
  1216. stringoffset:=secheader32.sh_offset;
  1217. seek(f,elfheader32.e_shoff);
  1218. status.datasize:=0;
  1219. for i:=0 to elfheader32.e_shnum-1 do
  1220. begin
  1221. blockread(f,secheader32,sizeof(secheader32));
  1222. secheader32:=MaybeSwapSecHeader(secheader32);
  1223. secname:=ReadSectionName(stringoffset+secheader32.sh_name);
  1224. case secname of
  1225. '.text':
  1226. begin
  1227. Message1(execinfo_x_codesize,tostr(secheader32.sh_size));
  1228. status.codesize:=secheader32.sh_size;
  1229. end;
  1230. '.fpcdata',
  1231. '.rodata',
  1232. '.data':
  1233. begin
  1234. Message1(execinfo_x_initdatasize,tostr(secheader32.sh_size));
  1235. inc(status.datasize,secheader32.sh_size);
  1236. end;
  1237. '.bss':
  1238. begin
  1239. Message1(execinfo_x_uninitdatasize,tostr(secheader32.sh_size));
  1240. inc(status.datasize,secheader32.sh_size);
  1241. end;
  1242. end;
  1243. end;
  1244. end;
  1245. 2:
  1246. begin
  1247. seek(f,0);
  1248. blockread(f,elfheader64,sizeof(tElf64header));
  1249. with elfheader64 do
  1250. if not((magic0123[0]=#$7f) and (magic0123[1]='E') and (magic0123[2]='L') and (magic0123[3]='F')) then
  1251. Exit;
  1252. elfheader64:=MayBeSwapHeader(elfheader64);
  1253. seek(f,elfheader64.e_shoff);
  1254. { read string section header }
  1255. seek(f,elfheader64.e_shoff+sizeof(TElf64sechdr)*elfheader64.e_shstrndx);
  1256. blockread(f,secheader64,sizeof(secheader64));
  1257. secheader64:=MaybeSwapSecHeader(secheader64);
  1258. stringoffset:=secheader64.sh_offset;
  1259. seek(f,elfheader64.e_shoff);
  1260. status.datasize:=0;
  1261. for i:=0 to elfheader64.e_shnum-1 do
  1262. begin
  1263. blockread(f,secheader64,sizeof(secheader64));
  1264. secheader64:=MaybeSwapSecHeader(secheader64);
  1265. secname:=ReadSectionName(stringoffset+secheader64.sh_name);
  1266. case secname of
  1267. '.text':
  1268. begin
  1269. Message1(execinfo_x_codesize,tostr(secheader64.sh_size));
  1270. status.codesize:=secheader64.sh_size;
  1271. end;
  1272. '.fpcdata',
  1273. '.rodata',
  1274. '.data':
  1275. begin
  1276. Message1(execinfo_x_initdatasize,tostr(secheader64.sh_size));
  1277. inc(status.datasize,secheader64.sh_size);
  1278. end;
  1279. '.bss':
  1280. begin
  1281. Message1(execinfo_x_uninitdatasize,tostr(secheader64.sh_size));
  1282. inc(status.datasize,secheader64.sh_size);
  1283. end;
  1284. end;
  1285. end;
  1286. end;
  1287. else
  1288. exit;
  1289. end;
  1290. close(f);
  1291. {$pop}
  1292. if ioresult<>0 then
  1293. ;
  1294. Result:=true;
  1295. end;
  1296. function TExternalLinker.PostProcessMachExecutable(const fn : string;isdll:boolean):boolean;
  1297. type
  1298. TMachHeader=record
  1299. magic : longword;
  1300. cputype : integer;
  1301. cpusubtype : integer;
  1302. filetype : longword;
  1303. ncmds : longword;
  1304. sizeofcmds : longword;
  1305. flags : longword;
  1306. reserved : longword;
  1307. end;
  1308. TMachLoadCommand = record
  1309. cmd : longword;
  1310. cmdsize : longword;
  1311. end;
  1312. TMachSegmentCommand64 = record
  1313. segname : array[0..15] of char;
  1314. vmaddr : qword;
  1315. vmsize : qword;
  1316. fileoff : qword;
  1317. filesize : qword;
  1318. maxprot : integer;
  1319. initprot : integer;
  1320. nsects : dword;
  1321. flags : dword;
  1322. end;
  1323. var
  1324. f : file;
  1325. machheader : TMachHeader;
  1326. machloadcmd : TMachLoadCommand;
  1327. machsegmentcommand64 :TMachSegmentCommand64;
  1328. i : longint;
  1329. begin
  1330. Result:=false;
  1331. { open file }
  1332. assign(f,fn);
  1333. {$push}{$I-}
  1334. reset(f,1);
  1335. if ioresult<>0 then
  1336. Message1(execinfo_f_cant_open_executable,fn);
  1337. {$ifdef DEBUG_MACHO_INFO}
  1338. writeln('Start reading Mach-O file');
  1339. {$endif DEBUG_MACHO_INFO}
  1340. blockread(f,machheader,sizeof(TMachHeader));
  1341. if machheader.magic<>$feedfacf then
  1342. Exit;
  1343. {$ifdef DEBUG_MACHO_INFO}
  1344. writeln('Magic header recognized (64 Bit, Little Endian)');
  1345. writeln('Reading ',machheader.ncmds,' commands');
  1346. {$endif DEBUG_MACHO_INFO}
  1347. for i:=1 to machheader.ncmds do
  1348. begin
  1349. blockread(f,machloadcmd,sizeof(machloadcmd));
  1350. case machloadcmd.cmd of
  1351. $19:
  1352. begin
  1353. blockread(f,machsegmentcommand64,sizeof(machsegmentcommand64));
  1354. {$ifdef DEBUG_MACHO_INFO}
  1355. writeln('Found SegmentCommand64: Name = ',StrPas(@machsegmentcommand64.segname),
  1356. '; VMSize = $',hexstr(machsegmentcommand64.vmsize,8),
  1357. '; FileSize = $',hexstr(machsegmentcommand64.filesize,8));
  1358. {$endif DEBUG_MACHO_INFO}
  1359. case StrPas(@machsegmentcommand64.segname) of
  1360. '__TEXT':
  1361. begin
  1362. Message1(execinfo_x_codesize,tostr(machsegmentcommand64.vmsize));
  1363. status.codesize:=machsegmentcommand64.vmsize;
  1364. end;
  1365. '__DATA_CONST':
  1366. begin
  1367. Message1(execinfo_x_initdatasize,tostr(machsegmentcommand64.vmsize));
  1368. inc(status.datasize,machsegmentcommand64.vmsize);
  1369. end;
  1370. '__DATA':
  1371. begin
  1372. Message1(execinfo_x_uninitdatasize,tostr(machsegmentcommand64.vmsize));
  1373. inc(status.datasize,machsegmentcommand64.vmsize);
  1374. end;
  1375. end;
  1376. Seek(f,FilePos(f)+machloadcmd.cmdsize-sizeof(machloadcmd)-sizeof(machsegmentcommand64));
  1377. end;
  1378. else
  1379. begin
  1380. {$ifdef DEBUG_MACHO_INFO}
  1381. writeln('Found Load Command: $',hexstr(machloadcmd.cmd,4),', skipping');
  1382. {$endif DEBUG_MACHO_INFO}
  1383. Seek(f,FilePos(f)+machloadcmd.cmdsize-sizeof(machloadcmd));
  1384. end;
  1385. end;
  1386. end;
  1387. close(f);
  1388. {$pop}
  1389. if ioresult<>0 then
  1390. ;
  1391. Result:=true;
  1392. end;
  1393. {*****************************************************************************
  1394. TINTERNALLINKER
  1395. *****************************************************************************}
  1396. Constructor TInternalLinker.Create;
  1397. begin
  1398. inherited Create;
  1399. linkscript:=TCmdStrList.Create;
  1400. FStaticLibraryList:=TFPObjectList.Create(true);
  1401. FImportLibraryList:=TFPHashObjectList.Create(true);
  1402. FGroupStack:=TFPObjectList.Create(false);
  1403. exemap:=nil;
  1404. exeoutput:=nil;
  1405. UseStabs:=false;
  1406. CObjInput:=TObjInput;
  1407. ScriptCount:=0;
  1408. IsHandled:=nil;
  1409. end;
  1410. Destructor TInternalLinker.Destroy;
  1411. begin
  1412. FGroupStack.Free;
  1413. FGroupStack := nil;
  1414. linkscript.free;
  1415. linkscript := nil;
  1416. FStaticLibraryList.Free;
  1417. FStaticLibraryList := nil;
  1418. FImportLibraryList.Free;
  1419. FImportLibraryList := nil;
  1420. if assigned(IsHandled) then
  1421. begin
  1422. IsHandled:=nil;
  1423. ScriptCount:=0;
  1424. end;
  1425. if assigned(exeoutput) then
  1426. begin
  1427. exeoutput.free;
  1428. exeoutput:=nil;
  1429. end;
  1430. if assigned(exemap) then
  1431. begin
  1432. exemap.free;
  1433. exemap:=nil;
  1434. end;
  1435. inherited destroy;
  1436. end;
  1437. procedure TInternalLinker.AddImportSymbol(const libname,symname,symmangledname:TCmdStr;OrdNr: longint;isvar:boolean);
  1438. var
  1439. ImportLibrary : TImportLibrary;
  1440. ImportSymbol : TFPHashObject;
  1441. begin
  1442. ImportLibrary:=TImportLibrary(ImportLibraryList.Find(libname));
  1443. if not assigned(ImportLibrary) then
  1444. ImportLibrary:=TImportLibrary.Create(ImportLibraryList,libname);
  1445. ImportSymbol:=TFPHashObject(ImportLibrary.ImportSymbolList.Find(symname));
  1446. if not assigned(ImportSymbol) then
  1447. ImportSymbol:=TImportSymbol.Create(ImportLibrary.ImportSymbolList,symname,symmangledname,OrdNr,isvar);
  1448. end;
  1449. procedure TInternalLinker.ScriptAddSourceStatements(AddSharedAsStatic:boolean);
  1450. var
  1451. s,s2: TCmdStr;
  1452. begin
  1453. while not ObjectFiles.Empty do
  1454. begin
  1455. s:=ObjectFiles.GetFirst;
  1456. if s<>'' then
  1457. LinkScript.Concat('READOBJECT '+MaybeQuoted(s));
  1458. end;
  1459. while not StaticLibFiles.Empty do
  1460. begin
  1461. s:=StaticLibFiles.GetFirst;
  1462. if s<>'' then
  1463. LinkScript.Concat('READSTATICLIBRARY '+MaybeQuoted(s));
  1464. end;
  1465. if not AddSharedAsStatic then
  1466. exit;
  1467. while not SharedLibFiles.Empty do
  1468. begin
  1469. S:=SharedLibFiles.GetFirst;
  1470. if FindLibraryFile(s,target_info.staticClibprefix,target_info.staticClibext,s2) then
  1471. LinkScript.Concat('READSTATICLIBRARY '+MaybeQuoted(s2))
  1472. else
  1473. Comment(V_Error,'Import library not found for '+S);
  1474. end;
  1475. end;
  1476. function TInternalLinker.GetCodeSize(aExeOutput: TExeOutput): QWord;
  1477. begin
  1478. Result:=aExeOutput.findexesection('.text').size;
  1479. end;
  1480. function TInternalLinker.GetDataSize(aExeOutput: TExeOutput): QWord;
  1481. begin
  1482. Result:=aExeOutput.findexesection('.data').size;
  1483. end;
  1484. function TInternalLinker.GetBssSize(aExeOutput: TExeOutput): QWord;
  1485. var
  1486. bsssec: TExeSection;
  1487. begin
  1488. bsssec:=aExeOutput.findexesection('.bss');
  1489. if assigned(bsssec) then
  1490. Result:=bsssec.size
  1491. else
  1492. Result:=0;
  1493. end;
  1494. procedure TInternalLinker.ParseLdScript(src:TScriptLexer);
  1495. var
  1496. asneeded: boolean;
  1497. group: TStaticLibrary;
  1498. procedure ParseInputList;
  1499. var
  1500. saved_asneeded: boolean;
  1501. begin
  1502. src.Expect('(');
  1503. repeat
  1504. if src.CheckForIdent('AS_NEEDED') then
  1505. begin
  1506. saved_asneeded:=asneeded;
  1507. asneeded:=true;
  1508. ParseInputList;
  1509. asneeded:=saved_asneeded;
  1510. end
  1511. else if src.token in [tkIDENT,tkLITERAL] then
  1512. begin
  1513. Load_ReadStaticLibrary(src.tokenstr,asneeded);
  1514. src.nextToken;
  1515. end
  1516. else if src.CheckFor('-') then
  1517. begin
  1518. { TODO: no whitespace between '-' and name;
  1519. name must begin with 'l' }
  1520. src.nextToken;
  1521. end
  1522. else { syntax error, no input_list_element term }
  1523. Break;
  1524. if src.CheckFor(',') then
  1525. Continue;
  1526. until src.CheckFor(')');
  1527. end;
  1528. begin
  1529. asneeded:=false;
  1530. src.nextToken;
  1531. repeat
  1532. if src.CheckForIdent('OUTPUT_FORMAT') then
  1533. begin
  1534. src.Expect('(');
  1535. //writeln('output_format(',src.tokenstr,')');
  1536. src.nextToken;
  1537. src.Expect(')');
  1538. end
  1539. else if src.CheckForIdent('GROUP') then
  1540. begin
  1541. group:=TStaticLibrary.create_group;
  1542. TFPObjectList(FGroupStack.Last).Add(group);
  1543. FGroupStack.Add(group.GroupMembers);
  1544. ParseInputList;
  1545. FGroupStack.Delete(FGroupStack.Count-1);
  1546. end
  1547. else if src.CheckFor(';') then
  1548. {skip semicolon};
  1549. until src.token in [tkEOF,tkINVALID];
  1550. end;
  1551. procedure TInternalLinker.Load_ReadObject(const para:TCmdStr);
  1552. var
  1553. objdata : TObjData;
  1554. objinput : TObjinput;
  1555. objreader : TObjectReader;
  1556. fn : TCmdStr;
  1557. begin
  1558. fn:=FindObjectFile(para,'',false);
  1559. Comment(V_Tried,'Reading object '+fn);
  1560. objinput:=CObjInput.Create;
  1561. objreader:=TObjectreader.create;
  1562. if objreader.openfile(fn) then
  1563. begin
  1564. if objinput.ReadObjData(objreader,objdata) then
  1565. exeoutput.addobjdata(objdata);
  1566. end;
  1567. { release input object }
  1568. objinput.free;
  1569. objinput := nil;
  1570. objreader.free;
  1571. objreader := nil;
  1572. end;
  1573. procedure TInternalLinker.Load_ReadStaticLibrary(const para:TCmdStr;asneededflag:boolean);
  1574. var
  1575. objreader : TObjectReader;
  1576. objinput: TObjInput;
  1577. objdata: TObjData;
  1578. ScriptLexer: TScriptLexer;
  1579. stmt:TStaticLibrary;
  1580. begin
  1581. { TODO: Cleanup ignoring of FPC generated libimp*.a files}
  1582. { Don't load import libraries }
  1583. if copy(ExtractFileName(para),1,6)='libimp' then
  1584. exit;
  1585. Comment(V_Tried,'Opening library '+para);
  1586. objreader:=CArObjectreader.createAr(para,true);
  1587. if ErrorCount>0 then
  1588. exit;
  1589. if objreader.isarchive then
  1590. TFPObjectList(FGroupStack.Last).Add(TStaticLibrary.Create(para,objreader,CObjInput))
  1591. else
  1592. if CObjInput.CanReadObjData(objreader) then
  1593. begin
  1594. { may be a regular object as well as a dynamic one }
  1595. objinput:=CObjInput.Create;
  1596. if objinput.ReadObjData(objreader,objdata) then
  1597. begin
  1598. stmt:=TStaticLibrary.create_object(objdata);
  1599. stmt.AsNeeded:=asneededflag;
  1600. TFPObjectList(FGroupStack.Last).Add(stmt);
  1601. end;
  1602. objinput.Free;
  1603. objinput := nil;
  1604. objreader.Free;
  1605. objreader := nil;
  1606. end
  1607. else { try parsing as script }
  1608. begin
  1609. Comment(V_Tried,'Interpreting '+para+' as ld script');
  1610. ScriptLexer:=TScriptLexer.Create(objreader);
  1611. ParseLdScript(ScriptLexer);
  1612. ScriptLexer.Free;
  1613. ScriptLexer := nil;
  1614. objreader.Free;
  1615. objreader := nil;
  1616. end;
  1617. end;
  1618. procedure TInternalLinker.Load_Group;
  1619. var
  1620. group: TStaticLibrary;
  1621. begin
  1622. group:=TStaticLibrary.create_group;
  1623. TFPObjectList(FGroupStack.Last).Add(group);
  1624. FGroupStack.Add(group.GroupMembers);
  1625. end;
  1626. procedure TInternalLinker.Load_EndGroup;
  1627. begin
  1628. FGroupStack.Delete(FGroupStack.Count-1);
  1629. end;
  1630. procedure TInternalLinker.ParseScript_Handle;
  1631. var
  1632. s{, para}, keyword : String;
  1633. hp : TCmdStrListItem;
  1634. i : longint;
  1635. begin
  1636. hp:=TCmdStrListItem(linkscript.first);
  1637. i:=0;
  1638. while assigned(hp) do
  1639. begin
  1640. inc(i);
  1641. s:=hp.str;
  1642. if (s='') or (s[1]='#') then
  1643. begin
  1644. hp:=TCmdStrListItem(hp.next);
  1645. continue;
  1646. end;
  1647. keyword:=Upper(GetToken(s,' '));
  1648. {para:=}GetToken(s,' ');
  1649. if Trim(s)<>'' then
  1650. Comment(V_Warning,'Unknown part "'+s+'" in "'+hp.str+'" internal linker script');
  1651. if (keyword<>'SYMBOL') and
  1652. (keyword<>'SYMBOLS') and
  1653. (keyword<>'STABS') and
  1654. (keyword<>'PROVIDE') and
  1655. (keyword<>'ZEROS') and
  1656. (keyword<>'BYTE') and
  1657. (keyword<>'WORD') and
  1658. (keyword<>'LONG') and
  1659. (keyword<>'QUAD') and
  1660. (keyword<>'ENTRYNAME') and
  1661. (keyword<>'ISSHAREDLIBRARY') and
  1662. (keyword<>'IMAGEBASE') and
  1663. (keyword<>'READOBJECT') and
  1664. (keyword<>'READSTATICLIBRARY') and
  1665. (keyword<>'EXESECTION') and
  1666. (keyword<>'ENDEXESECTION') and
  1667. (keyword<>'OBJSECTION') and
  1668. (keyword<>'HEADER') and
  1669. (keyword<>'GROUP') and
  1670. (keyword<>'ENDGROUP')
  1671. then
  1672. Comment(V_Warning,'Unknown keyword "'+keyword+'" in "'+hp.str
  1673. +'" internal linker script');
  1674. hp:=TCmdStrListItem(hp.next);
  1675. end;
  1676. ScriptCount:=i;
  1677. SetLength(IsHandled,ScriptCount+1); // 1-based index used.
  1678. end;
  1679. procedure TInternalLinker.ParseScript_PostCheck;
  1680. var
  1681. hp : TCmdStrListItem;
  1682. i : longint;
  1683. begin
  1684. hp:=TCmdStrListItem(linkscript.first);
  1685. i:=0;
  1686. while assigned(hp) do
  1687. begin
  1688. inc(i);
  1689. if not IsHandled[i] then
  1690. begin
  1691. Comment(V_Warning,'"'+hp.str+
  1692. '" internal linker script not handled');
  1693. end;
  1694. hp:=TCmdStrListItem(hp.next);
  1695. end;
  1696. end;
  1697. function TInternalLinker.ParsePara(const para : string) : string;
  1698. var
  1699. res : string;
  1700. begin
  1701. res:=trim(para);
  1702. { Remove enclosing braces }
  1703. if (length(res)>0) and (res[1]='(') and
  1704. (res[length(res)]=')') then
  1705. res:=trim(copy(res,2,length(res)-2));
  1706. result:=res;
  1707. end;
  1708. procedure TInternalLinker.ParseScript_Load;
  1709. var
  1710. s,
  1711. para,
  1712. keyword : String;
  1713. hp : TCmdStrListItem;
  1714. i : longint;
  1715. handled : boolean;
  1716. begin
  1717. exeoutput.Load_Start;
  1718. hp:=TCmdStrListItem(linkscript.first);
  1719. i:=0;
  1720. while assigned(hp) do
  1721. begin
  1722. inc(i);
  1723. s:=hp.str;
  1724. if (s='') or (s[1]='#') then
  1725. begin
  1726. IsHandled[i]:=true;
  1727. hp:=TCmdStrListItem(hp.next);
  1728. continue;
  1729. end;
  1730. handled:=true;
  1731. keyword:=Upper(GetToken(s,' '));
  1732. para:=ParsePara(GetToken(s,' '));
  1733. if keyword='SYMBOL' then
  1734. ExeOutput.Load_Symbol(para)
  1735. else if keyword='PROVIDE' then
  1736. ExeOutput.Load_ProvideSymbol(para)
  1737. else if keyword='ENTRYNAME' then
  1738. ExeOutput.Load_EntryName(para)
  1739. else if keyword='ISSHAREDLIBRARY' then
  1740. ExeOutput.Load_IsSharedLibrary
  1741. else if keyword='IMAGEBASE' then
  1742. ExeOutput.Load_ImageBase(para)
  1743. else if keyword='READOBJECT' then
  1744. Load_ReadObject(para)
  1745. else if keyword='STABS' then
  1746. UseStabs:=true
  1747. else if keyword='READSTATICLIBRARY' then
  1748. Load_ReadStaticLibrary(para)
  1749. else if keyword='GROUP' then
  1750. Load_Group
  1751. else if keyword='ENDGROUP' then
  1752. Load_EndGroup
  1753. else
  1754. handled:=false;
  1755. if handled then
  1756. IsHandled[i]:=true;
  1757. hp:=TCmdStrListItem(hp.next);
  1758. end;
  1759. end;
  1760. procedure TInternalLinker.ParseScript_Order;
  1761. var
  1762. s,
  1763. para,
  1764. keyword : String;
  1765. hp : TCmdStrListItem;
  1766. i : longint;
  1767. handled : boolean;
  1768. begin
  1769. exeoutput.Order_Start;
  1770. hp:=TCmdStrListItem(linkscript.first);
  1771. i:=0;
  1772. while assigned(hp) do
  1773. begin
  1774. inc(i);
  1775. s:=hp.str;
  1776. if (s='') or (s[1]='#') then
  1777. begin
  1778. hp:=TCmdStrListItem(hp.next);
  1779. continue;
  1780. end;
  1781. handled:=true;
  1782. keyword:=Upper(GetToken(s,' '));
  1783. para:=ParsePara(GetToken(s,' '));
  1784. if keyword='EXESECTION' then
  1785. ExeOutput.Order_ExeSection(para)
  1786. else if keyword='ENDEXESECTION' then
  1787. ExeOutput.Order_EndExeSection
  1788. else if keyword='OBJSECTION' then
  1789. ExeOutput.Order_ObjSection(para)
  1790. else if keyword='ZEROS' then
  1791. ExeOutput.Order_Zeros(para)
  1792. else if keyword='BYTE' then
  1793. ExeOutput.Order_Values(1,para)
  1794. else if keyword='WORD' then
  1795. ExeOutput.Order_Values(2,para)
  1796. else if keyword='LONG' then
  1797. ExeOutput.Order_Values(4,para)
  1798. else if keyword='QUAD' then
  1799. ExeOutput.Order_Values(8,para)
  1800. else if keyword='SYMBOL' then
  1801. ExeOutput.Order_Symbol(para)
  1802. else if keyword='PROVIDE' then
  1803. ExeOutput.Order_ProvideSymbol(para)
  1804. else
  1805. handled:=false;
  1806. if handled then
  1807. IsHandled[i]:=true;
  1808. hp:=TCmdStrListItem(hp.next);
  1809. end;
  1810. exeoutput.Order_End;
  1811. end;
  1812. procedure TInternalLinker.ParseScript_MemPos;
  1813. var
  1814. s,
  1815. para,
  1816. keyword : String;
  1817. hp : TCmdStrListItem;
  1818. i : longint;
  1819. handled : boolean;
  1820. begin
  1821. exeoutput.MemPos_Start;
  1822. hp:=TCmdStrListItem(linkscript.first);
  1823. i:=0;
  1824. while assigned(hp) do
  1825. begin
  1826. inc(i);
  1827. s:=hp.str;
  1828. if (s='') or (s[1]='#') then
  1829. begin
  1830. hp:=TCmdStrListItem(hp.next);
  1831. continue;
  1832. end;
  1833. handled:=true;
  1834. keyword:=Upper(GetToken(s,' '));
  1835. para:=ParsePara(GetToken(s,' '));
  1836. if keyword='EXESECTION' then
  1837. ExeOutput.MemPos_ExeSection(para)
  1838. else if keyword='ENDEXESECTION' then
  1839. ExeOutput.MemPos_EndExeSection
  1840. else if keyword='HEADER' then
  1841. ExeOutput.MemPos_Header
  1842. else
  1843. handled:=false;
  1844. if handled then
  1845. IsHandled[i]:=true;
  1846. hp:=TCmdStrListItem(hp.next);
  1847. end;
  1848. end;
  1849. procedure TInternalLinker.ParseScript_DataPos;
  1850. var
  1851. s,
  1852. para,
  1853. keyword : String;
  1854. hp : TCmdStrListItem;
  1855. i : longint;
  1856. handled : boolean;
  1857. begin
  1858. exeoutput.DataPos_Start;
  1859. hp:=TCmdStrListItem(linkscript.first);
  1860. i:=0;
  1861. while assigned(hp) do
  1862. begin
  1863. inc(i);
  1864. s:=hp.str;
  1865. if (s='') or (s[1]='#') then
  1866. begin
  1867. hp:=TCmdStrListItem(hp.next);
  1868. continue;
  1869. end;
  1870. handled:=true;
  1871. keyword:=Upper(GetToken(s,' '));
  1872. para:=ParsePara(GetToken(s,' '));
  1873. if keyword='EXESECTION' then
  1874. ExeOutput.DataPos_ExeSection(para)
  1875. else if keyword='ENDEXESECTION' then
  1876. ExeOutput.DataPos_EndExeSection
  1877. else if keyword='HEADER' then
  1878. ExeOutput.DataPos_Header
  1879. else if keyword='SYMBOLS' then
  1880. ExeOutput.DataPos_Symbols
  1881. else
  1882. handled:=false;
  1883. if handled then
  1884. IsHandled[i]:=true;
  1885. hp:=TCmdStrListItem(hp.next);
  1886. end;
  1887. end;
  1888. procedure TInternalLinker.PrintLinkerScript;
  1889. var
  1890. hp : TCmdStrListItem;
  1891. begin
  1892. if not assigned(exemap) then
  1893. exit;
  1894. exemap.Add('Used linker script');
  1895. exemap.Add('');
  1896. hp:=TCmdStrListItem(linkscript.first);
  1897. while assigned(hp) do
  1898. begin
  1899. exemap.Add(hp.str);
  1900. hp:=TCmdStrListItem(hp.next);
  1901. end;
  1902. end;
  1903. function TInternalLinker.RunLinkScript(const outputname:TCmdStr):boolean;
  1904. label
  1905. myexit;
  1906. var
  1907. bsssize : qword;
  1908. dbgname : TCmdStr;
  1909. begin
  1910. result:=false;
  1911. Message1(exec_i_linking,outputname);
  1912. FlushOutput;
  1913. exeoutput:=CExeOutput.Create;
  1914. { TODO: Load custom linker script}
  1915. DefaultLinkScript;
  1916. if (cs_link_map in current_settings.globalswitches) then
  1917. exemap:=texemap.create(current_module.mapfilename);
  1918. PrintLinkerScript;
  1919. { Check that syntax is OK }
  1920. ParseScript_Handle;
  1921. { Load .o files and resolve symbols }
  1922. FGroupStack.Add(FStaticLibraryList);
  1923. ParseScript_Load;
  1924. if ErrorCount>0 then
  1925. goto myexit;
  1926. exeoutput.ResolveSymbols(StaticLibraryList);
  1927. { Generate symbols and code to do the importing }
  1928. exeoutput.GenerateLibraryImports(ImportLibraryList);
  1929. { Fill external symbols data }
  1930. exeoutput.FixupSymbols;
  1931. if ErrorCount>0 then
  1932. goto myexit;
  1933. { parse linker options specific for output format }
  1934. exeoutput.ParseScript (linkscript);
  1935. { Create .exe sections and add .o sections }
  1936. ParseScript_Order;
  1937. exeoutput.RemoveUnreferencedSections;
  1938. { if UseStabs then, this would remove
  1939. STABS for empty linker scripts }
  1940. exeoutput.MergeStabs;
  1941. exeoutput.MarkEmptySections;
  1942. exeoutput.AfterUnusedSectionRemoval;
  1943. if ErrorCount>0 then
  1944. goto myexit;
  1945. { Calc positions in mem }
  1946. ParseScript_MemPos;
  1947. exeoutput.FixupRelocations;
  1948. exeoutput.RemoveUnusedExeSymbols;
  1949. exeoutput.PrintMemoryMap;
  1950. if ErrorCount>0 then
  1951. goto myexit;
  1952. if cs_link_separate_dbg_file in current_settings.globalswitches then
  1953. begin
  1954. { create debuginfo, which is an executable without data on disk }
  1955. dbgname:=ChangeFileExt(outputname,'.dbg');
  1956. exeoutput.ExeWriteMode:=ewm_dbgonly;
  1957. ParseScript_DataPos;
  1958. exeoutput.WriteExeFile(dbgname);
  1959. { create executable with link to just created debuginfo file }
  1960. exeoutput.ExeWriteMode:=ewm_exeonly;
  1961. exeoutput.RemoveDebugInfo;
  1962. exeoutput.GenerateDebugLink(ExtractFileName(dbgname),GetFileCRC(dbgname));
  1963. ParseScript_MemPos;
  1964. ParseScript_DataPos;
  1965. exeoutput.WriteExeFile(outputname);
  1966. end
  1967. else
  1968. begin
  1969. exeoutput.ExeWriteMode:=ewm_exefull;
  1970. ParseScript_DataPos;
  1971. exeoutput.WriteExeFile(outputname);
  1972. end;
  1973. { Post check that everything was handled }
  1974. ParseScript_PostCheck;
  1975. status.codesize:=GetCodeSize(exeoutput);
  1976. status.datasize:=GetDataSize(exeoutput);
  1977. bsssize:=GetBssSize(exeoutput);
  1978. { Executable info }
  1979. Message1(execinfo_x_codesize,tostr(status.codesize));
  1980. Message1(execinfo_x_initdatasize,tostr(status.datasize));
  1981. Message1(execinfo_x_uninitdatasize,tostr(bsssize));
  1982. Message1(execinfo_x_stackreserve,tostr(stacksize));
  1983. myexit:
  1984. { close map }
  1985. if assigned(exemap) then
  1986. begin
  1987. exemap.free;
  1988. exemap:=nil;
  1989. end;
  1990. { close exe }
  1991. exeoutput.free;
  1992. exeoutput:=nil;
  1993. result:=true;
  1994. end;
  1995. function TInternalLinker.ExecutableFilename:String;
  1996. begin
  1997. result:=current_module.exefilename;
  1998. end;
  1999. function TInternalLinker.SharedLibFilename:String;
  2000. begin
  2001. result:=current_module.sharedlibfilename;
  2002. end;
  2003. function TInternalLinker.MakeExecutable:boolean;
  2004. begin
  2005. IsSharedLibrary:=false;
  2006. result:=RunLinkScript(ExecutableFilename);
  2007. {$ifdef hasUnix}
  2008. fpchmod(current_module.exefilename,493);
  2009. {$endif hasUnix}
  2010. end;
  2011. function TInternalLinker.MakeSharedLibrary:boolean;
  2012. begin
  2013. IsSharedLibrary:=true;
  2014. result:=RunLinkScript(SharedLibFilename);
  2015. end;
  2016. procedure TInternalLinker.ScriptAddGenericSections(secnames:string);
  2017. var
  2018. secname:string;
  2019. begin
  2020. repeat
  2021. secname:=gettoken(secnames,',');
  2022. if secname='' then
  2023. break;
  2024. linkscript.Concat('EXESECTION '+secname);
  2025. linkscript.Concat(' OBJSECTION '+secname+'*');
  2026. linkscript.Concat('ENDEXESECTION');
  2027. until false;
  2028. end;
  2029. {*****************************************************************************
  2030. Init/Done
  2031. *****************************************************************************}
  2032. procedure RegisterLinker(id:tlink;c:TLinkerClass);
  2033. begin
  2034. CLinker[id]:=c;
  2035. end;
  2036. procedure InitLinker;
  2037. begin
  2038. if (cs_link_extern in current_settings.globalswitches) and
  2039. assigned(CLinker[target_info.linkextern]) then
  2040. begin
  2041. linker:=CLinker[target_info.linkextern].Create;
  2042. end
  2043. else
  2044. if assigned(CLinker[target_info.link]) then
  2045. begin
  2046. linker:=CLinker[target_info.link].Create;
  2047. end
  2048. else
  2049. linker:=Tlinker.Create;
  2050. end;
  2051. procedure DoneLinker;
  2052. begin
  2053. if assigned(linker) then
  2054. Linker.Free;
  2055. Linker := nil;
  2056. end;
  2057. {*****************************************************************************
  2058. Initialize
  2059. *****************************************************************************}
  2060. const
  2061. ar_gnu_ar_info : tarinfo =
  2062. (
  2063. id : ar_gnu_ar;
  2064. addfilecmd : '';
  2065. arfirstcmd : '';
  2066. arcmd : 'ar qS $LIB $FILES';
  2067. arfinishcmd : 'ar s $LIB'
  2068. );
  2069. ar_gnu_ar_scripted_info : tarinfo =
  2070. (
  2071. id : ar_gnu_ar_scripted;
  2072. addfilecmd : '';
  2073. arfirstcmd : '';
  2074. arcmd : 'ar -M < $SCRIPT';
  2075. arfinishcmd : ''
  2076. );
  2077. ar_gnu_gar_info : tarinfo =
  2078. ( id : ar_gnu_gar;
  2079. addfilecmd : '';
  2080. arfirstcmd : '';
  2081. arcmd : 'gar qS $LIB $FILES';
  2082. arfinishcmd : 'gar s $LIB'
  2083. );
  2084. ar_watcom_wlib_omf_info : tarinfo =
  2085. ( id : ar_watcom_wlib_omf;
  2086. addfilecmd : '+';
  2087. arfirstcmd : 'wlib -q $RECSIZE -fo -c -b -n -o=$OUTPUTLIB $LIB $FILES';
  2088. arcmd : 'wlib -q $RECSIZE -fo -c -b -o=$OUTPUTLIB $LIB $FILES';
  2089. arfinishcmd : ''
  2090. );
  2091. ar_watcom_wlib_omf_scripted_info : tarinfo =
  2092. (
  2093. id : ar_watcom_wlib_omf_scripted;
  2094. addfilecmd : '+';
  2095. arfirstcmd : '';
  2096. arcmd : 'wlib @$SCRIPT';
  2097. arfinishcmd : ''
  2098. );
  2099. ar_sdcc_sdar_info : tarinfo =
  2100. ( id : ar_sdcc_sdar;
  2101. addfilecmd : '';
  2102. arfirstcmd : '';
  2103. arcmd : 'sdar qS $LIB $FILES';
  2104. arfinishcmd : 'sdar s $LIB'
  2105. );
  2106. ar_sdcc_sdar_scripted_info : tarinfo =
  2107. (
  2108. id : ar_sdcc_sdar_scripted;
  2109. addfilecmd : '';
  2110. arfirstcmd : '';
  2111. arcmd : 'sdar -M < $SCRIPT';
  2112. arfinishcmd : ''
  2113. );
  2114. initialization
  2115. RegisterAr(ar_gnu_ar_info);
  2116. RegisterAr(ar_gnu_ar_scripted_info);
  2117. RegisterAr(ar_gnu_gar_info);
  2118. RegisterAr(ar_watcom_wlib_omf_info);
  2119. RegisterAr(ar_watcom_wlib_omf_scripted_info);
  2120. RegisterAr(ar_sdcc_sdar_info);
  2121. RegisterAr(ar_sdcc_sdar_scripted_info);
  2122. end.