link.pas 55 KB

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