link.pas 74 KB

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