link.pas 79 KB

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