link.pas 56 KB

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