link.pas 58 KB

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