link.pas 35 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088
  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. interface
  21. uses
  22. cclasses,
  23. systems,
  24. fmodule,
  25. globtype,
  26. ogbase;
  27. Type
  28. TLinkerInfo=record
  29. ExeCmd,
  30. DllCmd : array[1..3] of string;
  31. ResName : string[100];
  32. ScriptName : string[100];
  33. ExtraOptions : string;
  34. DynamicLinker : string[100];
  35. end;
  36. TLinker = class(TAbstractLinker)
  37. public
  38. HasResources,
  39. HasExports : boolean;
  40. ObjectFiles,
  41. SharedLibFiles,
  42. StaticLibFiles : TStringList;
  43. Constructor Create;virtual;
  44. Destructor Destroy;override;
  45. procedure AddModuleFiles(hp:tmodule);
  46. Procedure AddObject(const S,unitpath : String;isunit:boolean);
  47. Procedure AddStaticLibrary(const S : String);
  48. Procedure AddSharedLibrary(S : String);
  49. Procedure AddStaticCLibrary(const S : String);
  50. Procedure AddSharedCLibrary(S : String);
  51. procedure AddImportSymbol(const libname,symname:string;OrdNr: longint;isvar:boolean);virtual;
  52. Function MakeExecutable:boolean;virtual;
  53. Function MakeSharedLibrary:boolean;virtual;
  54. Function MakeStaticLibrary:boolean;virtual;
  55. procedure ExpandAndApplyOrder(var Src:TStringList);
  56. procedure LoadPredefinedLibraryOrder;virtual;
  57. function ReOrderEntries : boolean;
  58. end;
  59. TExternalLinker = class(TLinker)
  60. public
  61. Info : TLinkerInfo;
  62. Constructor Create;override;
  63. Destructor Destroy;override;
  64. Function FindUtil(const s:string):String;
  65. Function DoExec(const command:string; para:TCmdStr;showinfo,useshell:boolean):boolean;
  66. procedure SetDefaultInfo;virtual;
  67. Function MakeStaticLibrary:boolean;override;
  68. end;
  69. TInternalLinker = class(TLinker)
  70. private
  71. FCExeOutput : TExeOutputClass;
  72. FCObjInput : TObjInputClass;
  73. { Libraries }
  74. FStaticLibraryList : TFPHashObjectList;
  75. FImportLibraryList : TFPHashObjectList;
  76. procedure Load_ReadObject(const para:string);
  77. procedure Load_ReadStaticLibrary(const para:string);
  78. procedure ParseScript_Load;
  79. procedure ParseScript_Order;
  80. procedure ParseScript_CalcPos;
  81. procedure PrintLinkerScript;
  82. function RunLinkScript(const outputname:string):boolean;
  83. protected
  84. property CObjInput:TObjInputClass read FCObjInput write FCObjInput;
  85. property CExeOutput:TExeOutputClass read FCExeOutput write FCExeOutput;
  86. property StaticLibraryList:TFPHashObjectList read FStaticLibraryList;
  87. property ImportLibraryList:TFPHashObjectList read FImportLibraryList;
  88. procedure DefaultLinkScript;virtual;abstract;
  89. linkscript : TStringList;
  90. public
  91. IsSharedLibrary : boolean;
  92. Constructor Create;override;
  93. Destructor Destroy;override;
  94. Function MakeExecutable:boolean;override;
  95. Function MakeSharedLibrary:boolean;override;
  96. procedure AddImportSymbol(const libname,symname:string;OrdNr: longint;isvar:boolean);override;
  97. end;
  98. var
  99. Linker : TLinker;
  100. function FindObjectFile(s : string;const unitpath:string;isunit:boolean) : string;
  101. function FindLibraryFile(s:string;const prefix,ext:string;var foundfile : string) : boolean;
  102. function FindDLL(const s:string;var founddll:string):boolean;
  103. procedure InitLinker;
  104. procedure DoneLinker;
  105. Implementation
  106. uses
  107. SysUtils,
  108. cutils,cfileutils,
  109. script,globals,verbose,comphook,ppu,
  110. aasmbase,aasmtai,aasmdata,aasmcpu,
  111. owbase,owar,ogmap;
  112. type
  113. TLinkerClass = class of Tlinker;
  114. {*****************************************************************************
  115. Helpers
  116. *****************************************************************************}
  117. { searches an object file }
  118. function FindObjectFile(s:string;const unitpath:string;isunit:boolean) : string;
  119. var
  120. found : boolean;
  121. foundfile : string;
  122. begin
  123. findobjectfile:='';
  124. if s='' then
  125. exit;
  126. {When linking on target, the units has not been assembled yet,
  127. so there is no object files to look for at
  128. the host. Look for the corresponding assembler file instead,
  129. because it will be assembled to object file on the target.}
  130. if isunit and (cs_link_on_target in current_settings.globalswitches) then
  131. s:=ChangeFileExt(s,target_info.asmext);
  132. { when it does not belong to the unit then check if
  133. the specified file exists without searching any paths }
  134. if not isunit then
  135. begin
  136. if FileExists(FixFileName(s)) then
  137. begin
  138. foundfile:=ScriptFixFileName(s);
  139. found:=true;
  140. end;
  141. end;
  142. if pos('.',s)=0 then
  143. s:=s+target_info.objext;
  144. { find object file
  145. 1. output unit path
  146. 2. output exe path
  147. 3. specified unit path (if specified)
  148. 4. cwd
  149. 5. unit search path
  150. 6. local object path
  151. 7. global object path
  152. 8. exepath (not when linking on target) }
  153. found:=false;
  154. if isunit and (OutputUnitDir<>'') then
  155. found:=FindFile(s,OutPutUnitDir,foundfile)
  156. else
  157. if OutputExeDir<>'' then
  158. found:=FindFile(s,OutPutExeDir,foundfile);
  159. if (not found) and (unitpath<>'') then
  160. found:=FindFile(s,unitpath,foundfile);
  161. if (not found) then
  162. found:=FindFile(s, CurDirRelPath(source_info), foundfile);
  163. if (not found) then
  164. found:=UnitSearchPath.FindFile(s,foundfile);
  165. if (not found) then
  166. found:=current_module.localobjectsearchpath.FindFile(s,foundfile);
  167. if (not found) then
  168. found:=objectsearchpath.FindFile(s,foundfile);
  169. if not(cs_link_on_target in current_settings.globalswitches) and (not found) then
  170. found:=FindFile(s,exepath,foundfile);
  171. if not(cs_link_nolink in current_settings.globalswitches) and (not found) then
  172. Message1(exec_w_objfile_not_found,s);
  173. {Restore file extension}
  174. if isunit and (cs_link_on_target in current_settings.globalswitches) then
  175. foundfile:= ChangeFileExt(foundfile,target_info.objext);
  176. findobjectfile:=ScriptFixFileName(foundfile);
  177. end;
  178. { searches a (windows) DLL file }
  179. function FindDLL(const s:string;var founddll:string):boolean;
  180. var
  181. sysdir : string;
  182. Found : boolean;
  183. begin
  184. Found:=false;
  185. { Look for DLL in:
  186. 1. Current dir
  187. 2. Library Path
  188. 3. windir,windir/system,windir/system32 }
  189. Found:=FindFile(s,'.'+source_info.DirSep,founddll);
  190. if (not found) then
  191. Found:=librarysearchpath.FindFile(s,founddll);
  192. if (not found) then
  193. begin
  194. sysdir:=FixPath(GetEnvironmentVariable('windir'),false);
  195. Found:=FindFile(s,sysdir+';'+sysdir+'system'+source_info.DirSep+';'+sysdir+'system32'+source_info.DirSep,founddll);
  196. end;
  197. if (not found) then
  198. begin
  199. message1(exec_w_libfile_not_found,s);
  200. FoundDll:=s;
  201. end;
  202. FindDll:=Found;
  203. end;
  204. { searches an library file }
  205. function FindLibraryFile(s:string;const prefix,ext:string;var foundfile : string) : boolean;
  206. var
  207. found : boolean;
  208. paths : string;
  209. begin
  210. findlibraryfile:=false;
  211. foundfile:=s;
  212. if s='' then
  213. exit;
  214. { split path from filename }
  215. paths:=ExtractFilePath(s);
  216. s:=ExtractFileName(s);
  217. { add prefix 'lib' }
  218. if (prefix<>'') and (Copy(s,1,length(prefix))<>prefix) then
  219. s:=prefix+s;
  220. { add extension }
  221. if (ext<>'') and (Copy(s,length(s)-length(ext)+1,length(ext))<>ext) then
  222. s:=s+ext;
  223. { readd the split path }
  224. s:=paths+s;
  225. if FileExists(s) then
  226. begin
  227. foundfile:=ScriptFixFileName(s);
  228. FindLibraryFile:=true;
  229. exit;
  230. end;
  231. { find libary
  232. 1. cwd
  233. 2. local libary dir
  234. 3. global libary dir
  235. 4. exe path of the compiler (not when linking on target) }
  236. found:=FindFile(s, CurDirRelPath(source_info), foundfile);
  237. if (not found) and (current_module.outputpath^<>'') then
  238. found:=FindFile(s,current_module.outputpath^,foundfile);
  239. if (not found) then
  240. found:=current_module.locallibrarysearchpath.FindFile(s,foundfile);
  241. if (not found) then
  242. found:=librarysearchpath.FindFile(s,foundfile);
  243. if not(cs_link_on_target in current_settings.globalswitches) and (not found) then
  244. found:=FindFile(s,exepath,foundfile);
  245. foundfile:=ScriptFixFileName(foundfile);
  246. findlibraryfile:=found;
  247. end;
  248. {*****************************************************************************
  249. TLINKER
  250. *****************************************************************************}
  251. Constructor TLinker.Create;
  252. begin
  253. Inherited Create;
  254. ObjectFiles:=TStringList.Create_no_double;
  255. SharedLibFiles:=TStringList.Create_no_double;
  256. StaticLibFiles:=TStringList.Create_no_double;
  257. end;
  258. Destructor TLinker.Destroy;
  259. begin
  260. ObjectFiles.Free;
  261. SharedLibFiles.Free;
  262. StaticLibFiles.Free;
  263. end;
  264. procedure TLinker.AddModuleFiles(hp:tmodule);
  265. var
  266. mask : longint;
  267. i,j : longint;
  268. ImportLibrary : TImportLibrary;
  269. ImportSymbol : TImportSymbol;
  270. begin
  271. with hp do
  272. begin
  273. if (flags and uf_has_resourcefiles)<>0 then
  274. HasResources:=true;
  275. if (flags and uf_has_exports)<>0 then
  276. HasExports:=true;
  277. { link unit files }
  278. if (flags and uf_no_link)=0 then
  279. begin
  280. { create mask which unit files need linking }
  281. mask:=link_always;
  282. { static linking ? }
  283. if (cs_link_static in current_settings.globalswitches) then
  284. begin
  285. if (flags and uf_static_linked)=0 then
  286. begin
  287. { if smart not avail then try static linking }
  288. if (flags and uf_smart_linked)<>0 then
  289. begin
  290. Message1(exec_t_unit_not_static_linkable_switch_to_smart,modulename^);
  291. mask:=mask or link_smart;
  292. end
  293. else
  294. Message1(exec_e_unit_not_smart_or_static_linkable,modulename^);
  295. end
  296. else
  297. mask:=mask or link_static;
  298. end;
  299. { smart linking ? }
  300. if (cs_link_smart in current_settings.globalswitches) then
  301. begin
  302. if (flags and uf_smart_linked)=0 then
  303. begin
  304. { if smart not avail then try static linking }
  305. if (flags and uf_static_linked)<>0 then
  306. begin
  307. Message1(exec_t_unit_not_smart_linkable_switch_to_static,modulename^);
  308. mask:=mask or link_static;
  309. end
  310. else
  311. Message1(exec_e_unit_not_smart_or_static_linkable,modulename^);
  312. end
  313. else
  314. mask:=mask or link_smart;
  315. end;
  316. { shared linking }
  317. if (cs_link_shared in current_settings.globalswitches) then
  318. begin
  319. if (flags and uf_shared_linked)=0 then
  320. begin
  321. { if shared not avail then try static linking }
  322. if (flags and uf_static_linked)<>0 then
  323. begin
  324. Message1(exec_t_unit_not_shared_linkable_switch_to_static,modulename^);
  325. mask:=mask or link_static;
  326. end
  327. else
  328. Message1(exec_e_unit_not_shared_or_static_linkable,modulename^);
  329. end
  330. else
  331. mask:=mask or link_shared;
  332. end;
  333. { unit files }
  334. while not linkunitofiles.empty do
  335. AddObject(linkunitofiles.getusemask(mask),path^,true);
  336. while not linkunitstaticlibs.empty do
  337. AddStaticLibrary(linkunitstaticlibs.getusemask(mask));
  338. while not linkunitsharedlibs.empty do
  339. AddSharedLibrary(linkunitsharedlibs.getusemask(mask));
  340. end;
  341. { Other needed .o and libs, specified using $L,$LINKLIB,external }
  342. mask:=link_always;
  343. while not linkotherofiles.empty do
  344. AddObject(linkotherofiles.Getusemask(mask),path^,false);
  345. while not linkotherstaticlibs.empty do
  346. AddStaticCLibrary(linkotherstaticlibs.Getusemask(mask));
  347. while not linkothersharedlibs.empty do
  348. AddSharedCLibrary(linkothersharedlibs.Getusemask(mask));
  349. { Known Library/DLL Imports }
  350. for i:=0 to ImportLibraryList.Count-1 do
  351. begin
  352. ImportLibrary:=TImportLibrary(ImportLibraryList[i]);
  353. for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do
  354. begin
  355. ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
  356. AddImportSymbol(ImportLibrary.Name,ImportSymbol.Name,ImportSymbol.OrdNr,ImportSymbol.IsVar);
  357. end;
  358. end;
  359. end;
  360. end;
  361. procedure TLinker.AddImportSymbol(const libname,symname:string;OrdNr: longint;isvar:boolean);
  362. begin
  363. end;
  364. Procedure TLinker.AddObject(const S,unitpath : String;isunit:boolean);
  365. begin
  366. ObjectFiles.Concat(FindObjectFile(s,unitpath,isunit));
  367. end;
  368. Procedure TLinker.AddSharedLibrary(S:String);
  369. begin
  370. if s='' then
  371. exit;
  372. { remove prefix 'lib' }
  373. if Copy(s,1,length(target_info.sharedlibprefix))=target_info.sharedlibprefix then
  374. Delete(s,1,length(target_info.sharedlibprefix));
  375. { remove extension if any }
  376. if Copy(s,length(s)-length(target_info.sharedlibext)+1,length(target_info.sharedlibext))=target_info.sharedlibext then
  377. Delete(s,length(s)-length(target_info.sharedlibext)+1,length(target_info.sharedlibext)+1);
  378. { ready to be added }
  379. SharedLibFiles.Concat(S);
  380. end;
  381. Procedure TLinker.AddStaticLibrary(const S:String);
  382. var
  383. ns : string;
  384. found : boolean;
  385. begin
  386. if s='' then
  387. exit;
  388. found:=FindLibraryFile(s,target_info.staticlibprefix,target_info.staticlibext,ns);
  389. if not(cs_link_nolink in current_settings.globalswitches) and (not found) then
  390. Message1(exec_w_libfile_not_found,s);
  391. StaticLibFiles.Concat(ns);
  392. end;
  393. Procedure TLinker.AddSharedCLibrary(S:String);
  394. begin
  395. if s='' then
  396. exit;
  397. { remove prefix 'lib' }
  398. if Copy(s,1,length(target_info.sharedclibprefix))=target_info.sharedclibprefix then
  399. Delete(s,1,length(target_info.sharedclibprefix));
  400. { remove extension if any }
  401. if Copy(s,length(s)-length(target_info.sharedclibext)+1,length(target_info.sharedclibext))=target_info.sharedclibext then
  402. Delete(s,length(s)-length(target_info.sharedclibext)+1,length(target_info.sharedclibext)+1);
  403. { ready to be added }
  404. SharedLibFiles.Concat(S);
  405. end;
  406. Procedure TLinker.AddStaticCLibrary(const S:String);
  407. var
  408. ns : string;
  409. found : boolean;
  410. begin
  411. if s='' then
  412. exit;
  413. found:=FindLibraryFile(s,target_info.staticclibprefix,target_info.staticclibext,ns);
  414. if not(cs_link_nolink in current_settings.globalswitches) and (not found) then
  415. Message1(exec_w_libfile_not_found,s);
  416. StaticLibFiles.Concat(ns);
  417. end;
  418. procedure AddImportSymbol(const libname,symname:string;OrdNr: longint;isvar:boolean);
  419. begin
  420. end;
  421. function TLinker.MakeExecutable:boolean;
  422. begin
  423. MakeExecutable:=false;
  424. Message(exec_e_exe_not_supported);
  425. end;
  426. Function TLinker.MakeSharedLibrary:boolean;
  427. begin
  428. MakeSharedLibrary:=false;
  429. Message(exec_e_dll_not_supported);
  430. end;
  431. Function TLinker.MakeStaticLibrary:boolean;
  432. begin
  433. MakeStaticLibrary:=false;
  434. Message(exec_e_dll_not_supported);
  435. end;
  436. Procedure TLinker.ExpandAndApplyOrder(var Src:TStringList);
  437. var
  438. p : TLinkStrMap;
  439. i : longint;
  440. begin
  441. // call Virtual TLinker method to initialize
  442. LoadPredefinedLibraryOrder;
  443. // something to do?
  444. if (LinkLibraryAliases.count=0) and (LinkLibraryOrder.Count=0) Then
  445. exit;
  446. p:=TLinkStrMap.Create;
  447. // expand libaliases, clears src
  448. LinkLibraryAliases.expand(src,p);
  449. // writeln(src.count,' ',p.count,' ',linklibraryorder.count,' ',linklibraryaliases.count);
  450. // apply order
  451. p.UpdateWeights(LinkLibraryOrder);
  452. p.SortOnWeight;
  453. // put back in src
  454. for i:=0 to p.count-1 do
  455. src.insert(p[i].Key);
  456. p.free;
  457. end;
  458. procedure TLinker.LoadPredefinedLibraryOrder;
  459. begin
  460. end;
  461. function TLinker.ReOrderEntries : boolean;
  462. begin
  463. result:=(LinkLibraryOrder.count>0) or (LinkLibraryAliases.count>0);
  464. end;
  465. {*****************************************************************************
  466. TEXTERNALLINKER
  467. *****************************************************************************}
  468. Constructor TExternalLinker.Create;
  469. begin
  470. inherited Create;
  471. { set generic defaults }
  472. FillChar(Info,sizeof(Info),0);
  473. if cs_link_on_target in current_settings.globalswitches then
  474. begin
  475. Info.ResName:=outputexedir+ChangeFileExt(inputfilename,'_link.res');
  476. Info.ScriptName:=outputexedir+ChangeFileExt(inputfilename,'_script.res');
  477. end
  478. else
  479. begin
  480. Info.ResName:='link.res';
  481. Info.ScriptName:='script.res';
  482. end;
  483. { set the linker specific defaults }
  484. SetDefaultInfo;
  485. { Allow Parameter overrides for linker info }
  486. with Info do
  487. begin
  488. if ParaLinkOptions<>'' then
  489. ExtraOptions:=ParaLinkOptions;
  490. if ParaDynamicLinker<>'' then
  491. DynamicLinker:=ParaDynamicLinker;
  492. end;
  493. end;
  494. Destructor TExternalLinker.Destroy;
  495. begin
  496. inherited destroy;
  497. end;
  498. Procedure TExternalLinker.SetDefaultInfo;
  499. begin
  500. end;
  501. Function TExternalLinker.FindUtil(const s:string):string;
  502. var
  503. Found : boolean;
  504. FoundBin : string;
  505. UtilExe : string;
  506. begin
  507. if cs_link_on_target in current_settings.globalswitches then
  508. begin
  509. { If linking on target, don't add any path PM }
  510. FindUtil:=ChangeFileExt(s,target_info.exeext);
  511. exit;
  512. end;
  513. UtilExe:=ChangeFileExt(s,source_info.exeext);
  514. FoundBin:='';
  515. Found:=false;
  516. if utilsdirectory<>'' then
  517. Found:=FindFile(utilexe,utilsdirectory,Foundbin);
  518. if (not Found) then
  519. Found:=FindExe(utilexe,Foundbin);
  520. if (not Found) and not(cs_link_nolink in current_settings.globalswitches) then
  521. begin
  522. Message1(exec_e_util_not_found,utilexe);
  523. current_settings.globalswitches:=current_settings.globalswitches+[cs_link_nolink];
  524. end;
  525. if (FoundBin<>'') then
  526. Message1(exec_t_using_util,FoundBin);
  527. FindUtil:=FoundBin;
  528. end;
  529. Function TExternalLinker.DoExec(const command:string; para:TCmdStr;showinfo,useshell:boolean):boolean;
  530. var
  531. exitcode: longint;
  532. begin
  533. DoExec:=true;
  534. if not(cs_link_nolink in current_settings.globalswitches) then
  535. begin
  536. FlushOutput;
  537. if useshell then
  538. exitcode := shell(maybequoted(command)+' '+para)
  539. else
  540. try
  541. if ExecuteProcess(command,para) <> 0
  542. then begin
  543. Message(exec_e_error_while_linking);
  544. current_settings.globalswitches:=current_settings.globalswitches+[cs_link_nolink];
  545. DoExec:=false;
  546. end;
  547. except on E:EOSError do
  548. begin
  549. Message(exec_e_cant_call_linker);
  550. current_settings.globalswitches:=current_settings.globalswitches+[cs_link_nolink];
  551. DoExec:=false;
  552. end;
  553. end
  554. end;
  555. { Update asmres when externmode is set }
  556. if cs_link_nolink in current_settings.globalswitches then
  557. begin
  558. if showinfo then
  559. begin
  560. if DLLsource then
  561. AsmRes.AddLinkCommand(Command,Para,current_module.sharedlibfilename^)
  562. else
  563. AsmRes.AddLinkCommand(Command,Para,current_module.exefilename^);
  564. end
  565. else
  566. AsmRes.AddLinkCommand(Command,Para,'');
  567. end;
  568. end;
  569. Function TExternalLinker.MakeStaticLibrary:boolean;
  570. function GetNextFiles(const maxCmdLength : AInt; var item : TStringListItem) : string;
  571. begin
  572. result := '';
  573. while (assigned(item) and ((length(result) + length(item.str) + 1) < maxCmdLength)) do begin
  574. result := result + ' ' + item.str;
  575. item := TStringListItem(item.next);
  576. end;
  577. end;
  578. var
  579. binstr, scriptfile : string;
  580. success : boolean;
  581. cmdstr, nextcmd, smartpath : TCmdStr;
  582. current : TStringListItem;
  583. script: Text;
  584. scripted_ar : boolean;
  585. begin
  586. MakeStaticLibrary:=false;
  587. { remove the library, to be sure that it is rewritten }
  588. DeleteFile(current_module.staticlibfilename^);
  589. { Call AR }
  590. smartpath:=current_module.outputpath^+FixPath(ChangeFileExt(current_module.asmfilename^,target_info.smartext),false);
  591. SplitBinCmd(target_ar.arcmd,binstr,cmdstr);
  592. binstr := FindUtil(utilsprefix + binstr);
  593. scripted_ar:=target_ar.id=ar_gnu_ar_scripted;
  594. if scripted_ar then
  595. begin
  596. scriptfile := FixFileName(smartpath+'arscript.txt');
  597. Replace(cmdstr,'$SCRIPT',maybequoted(scriptfile));
  598. Assign(script, scriptfile);
  599. Rewrite(script);
  600. try
  601. writeln(script, 'CREATE ' + current_module.staticlibfilename^);
  602. current := TStringListItem(SmartLinkOFiles.First);
  603. while current <> nil do
  604. begin
  605. writeln(script, 'ADDMOD ' + current.str);
  606. current := TStringListItem(current.next);
  607. end;
  608. writeln(script, 'SAVE');
  609. writeln(script, 'END');
  610. finally
  611. Close(script);
  612. end;
  613. success:=DoExec(binstr,cmdstr,false,true);
  614. end
  615. else
  616. begin
  617. Replace(cmdstr,'$LIB',maybequoted(current_module.staticlibfilename^));
  618. { create AR commands }
  619. success := true;
  620. nextcmd := cmdstr;
  621. current := TStringListItem(SmartLinkOFiles.First);
  622. repeat
  623. Replace(nextcmd,'$FILES',GetNextFiles(240 - length(nextcmd) + 6 - length(binstr) - 1, current));
  624. success:=DoExec(binstr,nextcmd,false,true);
  625. nextcmd := cmdstr;
  626. until (not assigned(current)) or (not success);
  627. end;
  628. if (target_ar.arfinishcmd <> '') then
  629. begin
  630. SplitBinCmd(target_ar.arfinishcmd,binstr,cmdstr);
  631. Replace(cmdstr,'$LIB',maybequoted(current_module.staticlibfilename^));
  632. success:=DoExec(binstr,cmdstr,false,true);
  633. end;
  634. { Clean up }
  635. if not(cs_asm_leave in current_settings.globalswitches) then
  636. if not(cs_link_nolink in current_settings.globalswitches) then
  637. begin
  638. while not SmartLinkOFiles.Empty do
  639. DeleteFile(SmartLinkOFiles.GetFirst);
  640. if scripted_ar then
  641. DeleteFile(scriptfile);
  642. RemoveDir(smartpath);
  643. end
  644. else
  645. begin
  646. AsmRes.AddDeleteCommand(FixFileName(smartpath+current_module.asmprefix^+'*'+target_info.objext));
  647. if scripted_ar then
  648. AsmRes.AddDeleteCommand(scriptfile);
  649. AsmRes.AddDeleteDirCommand(smartpath);
  650. end;
  651. MakeStaticLibrary:=success;
  652. end;
  653. {*****************************************************************************
  654. TINTERNALLINKER
  655. *****************************************************************************}
  656. Constructor TInternalLinker.Create;
  657. begin
  658. inherited Create;
  659. linkscript:=TStringList.Create;
  660. FStaticLibraryList:=TFPHashObjectList.Create(true);
  661. FImportLibraryList:=TFPHashObjectList.Create(true);
  662. exemap:=nil;
  663. exeoutput:=nil;
  664. CObjInput:=TObjInput;
  665. end;
  666. Destructor TInternalLinker.Destroy;
  667. begin
  668. linkscript.free;
  669. StaticLibraryList.Free;
  670. ImportLibraryList.Free;
  671. if assigned(exeoutput) then
  672. begin
  673. exeoutput.free;
  674. exeoutput:=nil;
  675. end;
  676. if assigned(exemap) then
  677. begin
  678. exemap.free;
  679. exemap:=nil;
  680. end;
  681. inherited destroy;
  682. end;
  683. procedure TInternalLinker.AddImportSymbol(const libname,symname:string;OrdNr: longint;isvar:boolean);
  684. var
  685. ImportLibrary : TImportLibrary;
  686. ImportSymbol : TFPHashObject;
  687. begin
  688. ImportLibrary:=TImportLibrary(ImportLibraryList.Find(libname));
  689. if not assigned(ImportLibrary) then
  690. ImportLibrary:=TImportLibrary.Create(ImportLibraryList,libname);
  691. ImportSymbol:=TFPHashObject(ImportLibrary.ImportSymbolList.Find(symname));
  692. if not assigned(ImportSymbol) then
  693. ImportSymbol:=TImportSymbol.Create(ImportLibrary.ImportSymbolList,symname,OrdNr,isvar);
  694. end;
  695. procedure TInternalLinker.Load_ReadObject(const para:string);
  696. var
  697. objdata : TObjData;
  698. objinput : TObjinput;
  699. objreader : TObjectReader;
  700. fn : string;
  701. begin
  702. fn:=FindObjectFile(para,'',false);
  703. Comment(V_Tried,'Reading object '+fn);
  704. objinput:=CObjInput.Create;
  705. objdata:=objinput.newObjData(para);
  706. objreader:=TObjectreader.create;
  707. if objreader.openfile(fn) then
  708. begin
  709. if objinput.ReadObjData(objreader,objdata) then
  710. exeoutput.addobjdata(objdata);
  711. end;
  712. { release input object }
  713. objinput.free;
  714. objreader.free;
  715. end;
  716. procedure TInternalLinker.Load_ReadStaticLibrary(const para:string);
  717. var
  718. objreader : TObjectReader;
  719. begin
  720. {$warning TODO Cleanup ignoring of FPC generated libimp*.a files}
  721. { Don't load import libraries }
  722. if copy(ExtractFileName(para),1,6)='libimp' then
  723. exit;
  724. Comment(V_Tried,'Opening library '+para);
  725. objreader:=TArObjectreader.create(para);
  726. TStaticLibrary.Create(StaticLibraryList,para,objreader,CObjInput);
  727. end;
  728. procedure TInternalLinker.ParseScript_Load;
  729. var
  730. s,
  731. para,
  732. keyword : string;
  733. hp : TStringListItem;
  734. begin
  735. exeoutput.Load_Start;
  736. hp:=tstringlistitem(linkscript.first);
  737. while assigned(hp) do
  738. begin
  739. s:=hp.str;
  740. if (s='') or (s[1]='#') then
  741. continue;
  742. keyword:=Upper(GetToken(s,' '));
  743. para:=GetToken(s,' ');
  744. if keyword='SYMBOL' then
  745. ExeOutput.Load_Symbol(para)
  746. else if keyword='ENTRYNAME' then
  747. ExeOutput.Load_EntryName(para)
  748. else if keyword='ISSHAREDLIBRARY' then
  749. ExeOutput.Load_IsSharedLibrary
  750. else if keyword='IMAGEBASE' then
  751. ExeOutput.Load_ImageBase(para)
  752. else if keyword='READOBJECT' then
  753. Load_ReadObject(para)
  754. else if keyword='READSTATICLIBRARY' then
  755. Load_ReadStaticLibrary(para);
  756. hp:=tstringlistitem(hp.next);
  757. end;
  758. end;
  759. procedure TInternalLinker.ParseScript_Order;
  760. var
  761. s,
  762. para,
  763. keyword : string;
  764. hp : TStringListItem;
  765. begin
  766. exeoutput.Order_Start;
  767. hp:=tstringlistitem(linkscript.first);
  768. while assigned(hp) do
  769. begin
  770. s:=hp.str;
  771. if (s='') or (s[1]='#') then
  772. continue;
  773. keyword:=Upper(GetToken(s,' '));
  774. para:=GetToken(s,' ');
  775. if keyword='EXESECTION' then
  776. ExeOutput.Order_ExeSection(para)
  777. else if keyword='ENDEXESECTION' then
  778. ExeOutput.Order_EndExeSection
  779. else if keyword='OBJSECTION' then
  780. ExeOutput.Order_ObjSection(para)
  781. else if keyword='ZEROS' then
  782. ExeOutput.Order_Zeros(para)
  783. else if keyword='SYMBOL' then
  784. ExeOutput.Order_Symbol(para);
  785. hp:=tstringlistitem(hp.next);
  786. end;
  787. exeoutput.Order_End;
  788. end;
  789. procedure TInternalLinker.ParseScript_CalcPos;
  790. var
  791. s,
  792. para,
  793. keyword : string;
  794. hp : TStringListItem;
  795. begin
  796. exeoutput.CalcPos_Start;
  797. hp:=tstringlistitem(linkscript.first);
  798. while assigned(hp) do
  799. begin
  800. s:=hp.str;
  801. if (s='') or (s[1]='#') then
  802. continue;
  803. keyword:=Upper(GetToken(s,' '));
  804. para:=GetToken(s,' ');
  805. if keyword='EXESECTION' then
  806. ExeOutput.CalcPos_ExeSection(para)
  807. else if keyword='ENDEXESECTION' then
  808. ExeOutput.CalcPos_EndExeSection
  809. else if keyword='HEADER' then
  810. ExeOutput.CalcPos_Header
  811. else if keyword='SYMBOLS' then
  812. ExeOutput.CalcPos_Symbols;
  813. hp:=tstringlistitem(hp.next);
  814. end;
  815. end;
  816. procedure TInternalLinker.PrintLinkerScript;
  817. var
  818. hp : TStringListItem;
  819. begin
  820. if not assigned(exemap) then
  821. exit;
  822. exemap.Add('Used linker script');
  823. exemap.Add('');
  824. hp:=tstringlistitem(linkscript.first);
  825. while assigned(hp) do
  826. begin
  827. exemap.Add(hp.str);
  828. hp:=tstringlistitem(hp.next);
  829. end;
  830. end;
  831. function TInternalLinker.RunLinkScript(const outputname:string):boolean;
  832. label
  833. myexit;
  834. var
  835. bsssize : aint;
  836. begin
  837. result:=false;
  838. Message1(exec_i_linking,outputname);
  839. {$warning TODO Load custom linker script}
  840. DefaultLinkScript;
  841. exeoutput:=CExeOutput.Create;
  842. if (cs_link_map in current_settings.globalswitches) then
  843. exemap:=texemap.create(current_module.mapfilename^);
  844. PrintLinkerScript;
  845. { Load .o files and resolve symbols }
  846. ParseScript_Load;
  847. exeoutput.ResolveSymbols(StaticLibraryList);
  848. { Generate symbols and code to do the importing }
  849. exeoutput.GenerateLibraryImports(ImportLibraryList);
  850. { Fill external symbols data }
  851. exeoutput.FixupSymbols;
  852. if ErrorCount>0 then
  853. goto myexit;
  854. { Create .exe sections and add .o sections }
  855. ParseScript_Order;
  856. exeoutput.RemoveUnreferencedSections;
  857. exeoutput.MergeStabs;
  858. exeoutput.RemoveEmptySections;
  859. if ErrorCount>0 then
  860. goto myexit;
  861. { Calc positions in mem and file }
  862. ParseScript_CalcPos;
  863. exeoutput.FixupRelocations;
  864. exeoutput.PrintMemoryMap;
  865. if ErrorCount>0 then
  866. goto myexit;
  867. exeoutput.WriteExeFile(outputname);
  868. {$warning TODO fixed section names}
  869. status.codesize:=exeoutput.findexesection('.text').size;
  870. status.datasize:=exeoutput.findexesection('.data').size;
  871. bsssize:=exeoutput.findexesection('.bss').size;
  872. { Executable info }
  873. Message1(execinfo_x_codesize,tostr(status.codesize));
  874. Message1(execinfo_x_initdatasize,tostr(status.datasize));
  875. Message1(execinfo_x_uninitdatasize,tostr(bsssize));
  876. Message1(execinfo_x_stackreserve,tostr(stacksize));
  877. myexit:
  878. { close map }
  879. if assigned(exemap) then
  880. begin
  881. exemap.free;
  882. exemap:=nil;
  883. end;
  884. { close exe }
  885. exeoutput.free;
  886. exeoutput:=nil;
  887. result:=true;
  888. end;
  889. function TInternalLinker.MakeExecutable:boolean;
  890. begin
  891. IsSharedLibrary:=false;
  892. result:=RunLinkScript(current_module.exefilename^);
  893. end;
  894. function TInternalLinker.MakeSharedLibrary:boolean;
  895. begin
  896. IsSharedLibrary:=true;
  897. result:=RunLinkScript(current_module.sharedlibfilename^);
  898. end;
  899. {*****************************************************************************
  900. Init/Done
  901. *****************************************************************************}
  902. procedure InitLinker;
  903. var
  904. lk : TlinkerClass;
  905. begin
  906. if (cs_link_extern in current_settings.globalswitches) and
  907. assigned(target_info.linkextern) then
  908. begin
  909. lk:=TlinkerClass(target_info.linkextern);
  910. linker:=lk.Create;
  911. end
  912. else
  913. if assigned(target_info.link) then
  914. begin
  915. lk:=TLinkerClass(target_info.link);
  916. linker:=lk.Create;
  917. end
  918. else
  919. linker:=Tlinker.Create;
  920. end;
  921. procedure DoneLinker;
  922. begin
  923. if assigned(linker) then
  924. Linker.Free;
  925. end;
  926. {*****************************************************************************
  927. Initialize
  928. *****************************************************************************}
  929. const
  930. ar_gnu_ar_info : tarinfo =
  931. (
  932. id : ar_gnu_ar;
  933. arcmd : 'ar qS $LIB $FILES';
  934. arfinishcmd : 'ar s $LIB'
  935. );
  936. ar_gnu_ar_scripted_info : tarinfo =
  937. (
  938. id : ar_gnu_ar_scripted;
  939. arcmd : 'ar -M < $SCRIPT';
  940. arfinishcmd : ''
  941. );
  942. ar_gnu_gar_info : tarinfo =
  943. ( id : ar_gnu_gar;
  944. arcmd : 'gar qS $LIB $FILES';
  945. arfinishcmd : 'gar s $LIB'
  946. );
  947. initialization
  948. RegisterAr(ar_gnu_ar_info);
  949. RegisterAr(ar_gnu_ar_scripted_info);
  950. RegisterAr(ar_gnu_gar_info);
  951. end.