link.pas 36 KB

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