link.pas 59 KB

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