link.pas 56 KB

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