link.pas 36 KB

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