link.pas 55 KB

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