link.pas 59 KB

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