link.pas 58 KB

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