link.pas 54 KB

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