2
0

link.pas 79 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329
  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. { $define DEBUG_MACHO_INFO}
  21. interface
  22. uses
  23. sysutils,
  24. cclasses,
  25. systems,
  26. fmodule,
  27. globtype,
  28. ldscript,
  29. ogbase,
  30. owbase;
  31. Type
  32. TLinkerInfo=record
  33. ExeCmd,
  34. DllCmd,
  35. ExtDbgCmd : array[1..3] of ansistring;
  36. ResName : string[100];
  37. ScriptName : string[100];
  38. ExtraOptions : TCmdStr;
  39. DynamicLinker : string[100];
  40. end;
  41. TLinker = class(TObject)
  42. public
  43. HasResources,
  44. HasExports : boolean;
  45. SysInitUnit : string[20];
  46. ObjectFiles,
  47. SharedLibFiles,
  48. StaticLibFiles,
  49. FrameworkFiles,
  50. OrderedSymbols: TCmdStrList;
  51. Constructor Create;virtual;
  52. Destructor Destroy;override;
  53. procedure AddModuleFiles(hp:tmodule);
  54. Procedure AddObject(const S,unitpath : TPathStr;isunit:boolean);
  55. Procedure AddStaticLibrary(const S : TCmdStr);
  56. Procedure AddSharedLibrary(S : TCmdStr);
  57. Procedure AddStaticCLibrary(const S : TCmdStr);
  58. Procedure AddSharedCLibrary(S : TCmdStr);
  59. Procedure AddFramework(S : TCmdStr);
  60. Procedure AddOrderedSymbol(const s: TCmdStr);
  61. procedure AddImportSymbol(const libname,symname,symmangledname:TCmdStr;OrdNr: longint;isvar:boolean);virtual;
  62. Procedure InitSysInitUnitName;virtual;
  63. Function MakeExecutable:boolean;virtual;
  64. Function MakeSharedLibrary:boolean;virtual;
  65. Function MakeStaticLibrary:boolean;virtual;
  66. procedure ExpandAndApplyOrder(var Src:TCmdStrList);
  67. procedure LoadPredefinedLibraryOrder;virtual;
  68. function ReOrderEntries : boolean;
  69. end;
  70. TExternalLinker = class(TLinker)
  71. protected
  72. Function WriteSymbolOrderFile: TCmdStr;
  73. Function GetSanitizerLibName(const basename: TCmdStr; withArch: boolean): TCmdStr;
  74. Function AddSanitizerLibrariesAndGetSearchDir(const platformname: TCmdStr; out sanitizerlibrarydir: TCmdStr): boolean;
  75. public
  76. Info : TLinkerInfo;
  77. Constructor Create;override;
  78. Destructor Destroy;override;
  79. Function FindUtil(const s:TCmdStr;throwerror: boolean=true):TCmdStr;
  80. Function CatFileContent(para:TCmdStr):TCmdStr;
  81. Function DoExec(const command:TCmdStr; para:TCmdStr;showinfo,useshell:boolean):boolean;
  82. procedure SetDefaultInfo;virtual;
  83. Function MakeStaticLibrary:boolean;override;
  84. Function UniqueName(const str:TCmdStr): TCmdStr;
  85. function PostProcessELFExecutable(const fn: string; isdll: boolean): boolean;
  86. function PostProcessMachExecutable(const fn: string; isdll: boolean): boolean;
  87. end;
  88. TBooleanArray = array [1..100000] of boolean;
  89. PBooleanArray = ^TBooleanArray;
  90. TInternalLinker = class(TLinker)
  91. private
  92. FCExeOutput : TExeOutputClass;
  93. FCObjInput : TObjInputClass;
  94. FCArObjectReader : TObjectReaderClass;
  95. { Libraries }
  96. FStaticLibraryList : TFPObjectList;
  97. FImportLibraryList : TFPHashObjectList;
  98. FGroupStack : TFPObjectList;
  99. procedure Load_ReadObject(const para:TCmdStr);
  100. procedure Load_ReadStaticLibrary(const para:TCmdStr;asneededflag:boolean=false);
  101. procedure Load_Group;
  102. procedure Load_EndGroup;
  103. procedure ParseScript_Handle;
  104. procedure ParseScript_PostCheck;
  105. procedure ParseScript_Load;
  106. function ParsePara(const para : string) : string;
  107. procedure ParseScript_Order;
  108. procedure ParseScript_MemPos;
  109. procedure ParseScript_DataPos;
  110. procedure PrintLinkerScript;
  111. function RunLinkScript(const outputname:TCmdStr):boolean;
  112. procedure ParseLdScript(src:TScriptLexer);
  113. protected
  114. linkscript : TCmdStrList;
  115. ScriptCount : longint;
  116. IsHandled : PBooleanArray;
  117. property CArObjectReader:TObjectReaderClass read FCArObjectReader write FCArObjectReader;
  118. property CObjInput:TObjInputClass read FCObjInput write FCObjInput;
  119. property CExeOutput:TExeOutputClass read FCExeOutput write FCExeOutput;
  120. property StaticLibraryList:TFPObjectList read FStaticLibraryList;
  121. property ImportLibraryList:TFPHashObjectList read FImportLibraryList;
  122. procedure DefaultLinkScript;virtual;abstract;
  123. procedure ScriptAddGenericSections(secnames:string);
  124. procedure ScriptAddSourceStatements(AddSharedAsStatic:boolean);virtual;
  125. function GetCodeSize(aExeOutput: TExeOutput): QWord;virtual;
  126. function GetDataSize(aExeOutput: TExeOutput): QWord;virtual;
  127. function GetBssSize(aExeOutput: TExeOutput): QWord;virtual;
  128. function ExecutableFilename:String;virtual;
  129. function SharedLibFilename:String;virtual;
  130. public
  131. IsSharedLibrary : boolean;
  132. UseStabs : boolean;
  133. Constructor Create;override;
  134. Destructor Destroy;override;
  135. Function MakeExecutable:boolean;override;
  136. Function MakeSharedLibrary:boolean;override;
  137. procedure AddImportSymbol(const libname,symname,symmangledname:TCmdStr;OrdNr: longint;isvar:boolean);override;
  138. end;
  139. TLinkerClass = class of Tlinker;
  140. var
  141. Linker : TLinker;
  142. function FindObjectFile(s : TCmdStr;const unitpath:TCmdStr;isunit:boolean) : TCmdStr;
  143. function FindLibraryFile(s:TCmdStr;const prefix,ext:TCmdStr;var foundfile : TCmdStr) : boolean;
  144. function FindDLL(const s:TCmdStr;var founddll:TCmdStr):boolean;
  145. procedure RegisterLinker(id:tlink;c:TLinkerClass);
  146. procedure InitLinker;
  147. procedure DoneLinker;
  148. Implementation
  149. uses
  150. cutils,cfileutl,cstreams,
  151. {$ifdef hasUnix}
  152. baseunix,
  153. {$endif hasUnix}
  154. cscript,globals,verbose,comphook,ppu,fpchash,triplet,tripletcpu,
  155. aasmbase,aasmcpu,
  156. ogmap;
  157. var
  158. CLinker : array[tlink] of TLinkerClass;
  159. {*****************************************************************************
  160. Helpers
  161. *****************************************************************************}
  162. function GetFileCRC(const fn:TPathStr):cardinal;
  163. var
  164. fs : TCStream;
  165. bufcount,
  166. bufsize : Integer;
  167. buf : pbyte;
  168. begin
  169. result:=0;
  170. bufsize:=64*1024;
  171. fs:=CFileStreamClass.Create(fn,fmOpenRead or fmShareDenyNone);
  172. if CStreamError<>0 then
  173. begin
  174. fs.Free;
  175. Comment(V_Error,'Can''t open file: '+fn);
  176. exit;
  177. end;
  178. getmem(buf,bufsize);
  179. repeat
  180. bufcount:=fs.Read(buf^,bufsize);
  181. result:=UpdateCrc32(result,buf^,bufcount);
  182. until bufcount<bufsize;
  183. freemem(buf);
  184. fs.Free;
  185. end;
  186. { searches an object file }
  187. function FindObjectFile(s:TCmdStr;const unitpath:TCmdStr;isunit:boolean) : TCmdStr;
  188. var
  189. found : boolean;
  190. foundfile : TCmdStr;
  191. begin
  192. findobjectfile:='';
  193. if s='' then
  194. exit;
  195. {When linking on target, the units has not been assembled yet,
  196. if assembling is also done on target,
  197. so there is no object files to look for at
  198. the host. Look for the corresponding assembler file instead,
  199. because it will be assembled to object file on the target.}
  200. if isunit and (cs_assemble_on_target in current_settings.globalswitches) then
  201. s:=ChangeFileExt(s,target_info.asmext);
  202. { when it does not belong to the unit then check if
  203. the specified file exists without searching any paths }
  204. if not isunit then
  205. begin
  206. if FileExists(FixFileName(s),false) then
  207. begin
  208. foundfile:=ScriptFixFileName(s);
  209. found:=true;
  210. end;
  211. end;
  212. if pos('.',s)=0 then
  213. s:=s+target_info.objext;
  214. { find object file
  215. 1. output unit path
  216. 2. output exe path
  217. 3. specified unit path (if specified)
  218. 4. cwd
  219. 5. unit search path
  220. 6. local object path
  221. 7. global object path
  222. 8. exepath (not when linking on target)
  223. for all finds don't use the directory caching }
  224. found:=false;
  225. if isunit and (OutputUnitDir<>'') then
  226. found:=FindFile(s,OutPutUnitDir,false,foundfile)
  227. else
  228. if OutputExeDir<>'' then
  229. found:=FindFile(s,OutPutExeDir,false,foundfile);
  230. if (not found) and (unitpath<>'') then
  231. found:=FindFile(s,unitpath,false,foundfile);
  232. if (not found) then
  233. found:=FindFile(s, CurDirRelPath(source_info),false,foundfile);
  234. if (not found) then
  235. found:=UnitSearchPath.FindFile(s,false,foundfile);
  236. if (not found) then
  237. found:=current_module.localobjectsearchpath.FindFile(s,false,foundfile);
  238. if (not found) then
  239. found:=objectsearchpath.FindFile(s,false,foundfile);
  240. if not(cs_link_on_target in current_settings.globalswitches) and (not found) then
  241. found:=FindFile(s,exepath,false,foundfile);
  242. if not(cs_link_nolink in current_settings.globalswitches) and (not found) then
  243. Message1(exec_w_objfile_not_found,s);
  244. {Restore file extension}
  245. if isunit and (cs_assemble_on_target in current_settings.globalswitches) then
  246. foundfile:= ChangeFileExt(foundfile,target_info.objext);
  247. findobjectfile:=ScriptFixFileName(foundfile);
  248. end;
  249. { searches a (windows) DLL file }
  250. function FindDLL(const s:TCmdStr;var founddll:TCmdStr):boolean;
  251. var
  252. sysdir : TCmdStr;
  253. Found : boolean;
  254. begin
  255. Found:=false;
  256. { Look for DLL in:
  257. 1. Current dir
  258. 2. Library Path
  259. 3. windir,windir/system,windir/system32 }
  260. Found:=FindFile(s,'.'+source_info.DirSep,false,founddll);
  261. if (not found) then
  262. Found:=librarysearchpath.FindFile(s,false,founddll);
  263. { when cross compiling, it is pretty useless to search windir etc. for dlls }
  264. if (not found) and (source_info.system=target_info.system) then
  265. begin
  266. sysdir:=FixPath(GetEnvironmentVariable('windir'),false);
  267. Found:=FindFile(s,sysdir+';'+sysdir+'system'+source_info.DirSep+';'+sysdir+'system32'+source_info.DirSep,false,founddll);
  268. end;
  269. if (not found) then
  270. begin
  271. message1(exec_w_libfile_not_found,s);
  272. FoundDll:=s;
  273. end;
  274. FindDll:=Found;
  275. end;
  276. { searches an library file }
  277. function FindLibraryFile(s:TCmdStr;const prefix,ext:TCmdStr;var foundfile : TCmdStr) : boolean;
  278. var
  279. found : boolean;
  280. paths : TCmdStr;
  281. begin
  282. findlibraryfile:=false;
  283. foundfile:=s;
  284. if s='' then
  285. exit;
  286. { split path from filename }
  287. paths:=ExtractFilePath(s);
  288. s:=ExtractFileName(s);
  289. { add prefix 'lib' }
  290. if (prefix<>'') and (Copy(s,1,length(prefix))<>prefix) then
  291. s:=prefix+s;
  292. { add extension }
  293. if (ext<>'') and (Copy(s,length(s)-length(ext)+1,length(ext))<>ext) then
  294. s:=s+ext;
  295. { readd the split path }
  296. s:=paths+s;
  297. if FileExists(s,false) then
  298. begin
  299. foundfile:=ScriptFixFileName(s);
  300. FindLibraryFile:=true;
  301. exit;
  302. end;
  303. { find libary
  304. 1. cwd
  305. 2. local libary dir
  306. 3. global libary dir
  307. 4. exe path of the compiler (not when linking on target)
  308. for all searches don't use the directory cache }
  309. found:=FindFile(s, CurDirRelPath(source_info), false,foundfile);
  310. if (not found) and (current_module.outputpath<>'') then
  311. found:=FindFile(s,current_module.outputpath,false,foundfile);
  312. if (not found) then
  313. found:=current_module.locallibrarysearchpath.FindFile(s,false,foundfile);
  314. if (not found) then
  315. found:=librarysearchpath.FindFile(s,false,foundfile);
  316. if not(cs_link_on_target in current_settings.globalswitches) and (not found) then
  317. found:=FindFile(s,exepath,false,foundfile);
  318. foundfile:=ScriptFixFileName(foundfile);
  319. findlibraryfile:=found;
  320. end;
  321. {*****************************************************************************
  322. TLINKER
  323. *****************************************************************************}
  324. Constructor TLinker.Create;
  325. begin
  326. Inherited Create;
  327. ObjectFiles:=TCmdStrList.Create_no_double;
  328. SharedLibFiles:=TCmdStrList.Create_no_double;
  329. StaticLibFiles:=TCmdStrList.Create_no_double;
  330. FrameworkFiles:=TCmdStrList.Create_no_double;
  331. OrderedSymbols:=TCmdStrList.Create;
  332. end;
  333. Destructor TLinker.Destroy;
  334. begin
  335. ObjectFiles.Free;
  336. SharedLibFiles.Free;
  337. StaticLibFiles.Free;
  338. FrameworkFiles.Free;
  339. OrderedSymbols.Free;
  340. inherited;
  341. end;
  342. procedure TLinker.AddModuleFiles(hp:tmodule);
  343. var
  344. mask : longint;
  345. i,j : longint;
  346. ImportLibrary : TImportLibrary;
  347. ImportSymbol : TImportSymbol;
  348. begin
  349. with hp do
  350. begin
  351. if mf_has_resourcefiles in moduleflags then
  352. HasResources:=true;
  353. if mf_has_exports in moduleflags then
  354. HasExports:=true;
  355. { link unit files }
  356. if (headerflags and uf_no_link)=0 then
  357. begin
  358. { create mask which unit files need linking }
  359. mask:=link_always;
  360. { lto linking ?}
  361. if (cs_lto in current_settings.moduleswitches) and
  362. ((headerflags and uf_lto_linked)<>0) and
  363. (not(cs_lto_nosystem in init_settings.globalswitches) or
  364. (hp.modulename^<>'SYSTEM')) then
  365. begin
  366. mask:=mask or link_lto;
  367. end
  368. else
  369. begin
  370. { static linking ? }
  371. if (cs_link_static in current_settings.globalswitches) then
  372. begin
  373. if (headerflags and uf_static_linked)=0 then
  374. begin
  375. { if static not avail then try smart linking }
  376. if (headerflags and uf_smart_linked)<>0 then
  377. begin
  378. Message1(exec_t_unit_not_static_linkable_switch_to_smart,modulename^);
  379. mask:=mask or link_smart;
  380. end
  381. else
  382. Message1(exec_e_unit_not_smart_or_static_linkable,modulename^);
  383. end
  384. else
  385. mask:=mask or link_static;
  386. end;
  387. { smart linking ? }
  388. if (cs_link_smart in current_settings.globalswitches) then
  389. begin
  390. if (headerflags and uf_smart_linked)=0 then
  391. begin
  392. { if smart not avail then try static linking }
  393. if (headerflags and uf_static_linked)<>0 then
  394. begin
  395. { if not create_smartlink_library, then smart linking happens using the
  396. regular object files
  397. }
  398. if create_smartlink_library then
  399. Message1(exec_t_unit_not_smart_linkable_switch_to_static,modulename^);
  400. mask:=mask or link_static;
  401. end
  402. else
  403. Message1(exec_e_unit_not_smart_or_static_linkable,modulename^);
  404. end
  405. else
  406. mask:=mask or link_smart;
  407. end;
  408. { shared linking }
  409. if (cs_link_shared in current_settings.globalswitches) then
  410. begin
  411. if (headerflags and uf_shared_linked)=0 then
  412. begin
  413. { if shared not avail then try static linking }
  414. if (headerflags and uf_static_linked)<>0 then
  415. begin
  416. Message1(exec_t_unit_not_shared_linkable_switch_to_static,modulename^);
  417. mask:=mask or link_static;
  418. end
  419. else
  420. Message1(exec_e_unit_not_shared_or_static_linkable,modulename^);
  421. end
  422. else
  423. mask:=mask or link_shared;
  424. end;
  425. end;
  426. { unit files }
  427. while not linkunitofiles.empty do
  428. AddObject(linkunitofiles.getusemask(mask),path,true);
  429. while not linkunitstaticlibs.empty do
  430. AddStaticLibrary(linkunitstaticlibs.getusemask(mask));
  431. while not linkunitsharedlibs.empty do
  432. AddSharedLibrary(linkunitsharedlibs.getusemask(mask));
  433. end;
  434. { Other needed .o and libs, specified using $L,$LINKLIB,external }
  435. mask:=link_always;
  436. while not linkotherofiles.empty do
  437. AddObject(linkotherofiles.Getusemask(mask),path,false);
  438. while not linkotherstaticlibs.empty do
  439. AddStaticCLibrary(linkotherstaticlibs.Getusemask(mask));
  440. while not linkothersharedlibs.empty do
  441. AddSharedCLibrary(linkothersharedlibs.Getusemask(mask));
  442. while not linkotherframeworks.empty do
  443. AddFramework(linkotherframeworks.Getusemask(mask));
  444. { Known Library/DLL Imports }
  445. for i:=0 to ImportLibraryList.Count-1 do
  446. begin
  447. ImportLibrary:=TImportLibrary(ImportLibraryList[i]);
  448. for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do
  449. begin
  450. ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
  451. AddImportSymbol(ImportLibrary.Name,ImportSymbol.Name,
  452. ImportSymbol.MangledName,ImportSymbol.OrdNr,ImportSymbol.IsVar);
  453. end;
  454. end;
  455. { ordered symbols }
  456. OrderedSymbols.concatList(linkorderedsymbols);
  457. end;
  458. end;
  459. procedure TLinker.AddImportSymbol(const libname,symname,symmangledname:TCmdStr;OrdNr: longint;isvar:boolean);
  460. begin
  461. end;
  462. Procedure TLinker.AddObject(const S,unitpath : TPathStr;isunit:boolean);
  463. begin
  464. ObjectFiles.Concat(FindObjectFile(s,unitpath,isunit))
  465. end;
  466. Procedure TLinker.AddSharedLibrary(S:TCmdStr);
  467. begin
  468. if s='' then
  469. exit;
  470. { remove prefix 'lib' }
  471. if Copy(s,1,length(target_info.sharedlibprefix))=target_info.sharedlibprefix then
  472. Delete(s,1,length(target_info.sharedlibprefix));
  473. { remove extension if any }
  474. if Copy(s,length(s)-length(target_info.sharedlibext)+1,length(target_info.sharedlibext))=target_info.sharedlibext then
  475. Delete(s,length(s)-length(target_info.sharedlibext)+1,length(target_info.sharedlibext)+1);
  476. { ready to be added }
  477. SharedLibFiles.Concat(S);
  478. end;
  479. Procedure TLinker.AddStaticLibrary(const S:TCmdStr);
  480. var
  481. ns : TCmdStr;
  482. found : boolean;
  483. begin
  484. if s='' then
  485. exit;
  486. found:=FindLibraryFile(s,target_info.staticlibprefix,target_info.staticlibext,ns);
  487. if not(cs_link_nolink in current_settings.globalswitches) and (not found) then
  488. Message1(exec_w_libfile_not_found,s);
  489. StaticLibFiles.Concat(ns);
  490. end;
  491. Procedure TLinker.AddSharedCLibrary(S:TCmdStr);
  492. begin
  493. if s='' then
  494. exit;
  495. { remove prefix 'lib' }
  496. if Copy(s,1,length(target_info.sharedclibprefix))=target_info.sharedclibprefix then
  497. Delete(s,1,length(target_info.sharedclibprefix));
  498. { remove extension if any }
  499. if Copy(s,length(s)-length(target_info.sharedclibext)+1,length(target_info.sharedclibext))=target_info.sharedclibext then
  500. Delete(s,length(s)-length(target_info.sharedclibext)+1,length(target_info.sharedclibext)+1);
  501. { ready to be added }
  502. SharedLibFiles.Concat(S);
  503. end;
  504. Procedure TLinker.AddFramework(S:TCmdStr);
  505. begin
  506. if s='' then
  507. exit;
  508. { ready to be added }
  509. FrameworkFiles.Concat(S);
  510. end;
  511. procedure TLinker.AddOrderedSymbol(const s: TCmdStr);
  512. begin
  513. OrderedSymbols.Concat(s);
  514. end;
  515. Procedure TLinker.AddStaticCLibrary(const S:TCmdStr);
  516. var
  517. ns : TCmdStr;
  518. found : boolean;
  519. begin
  520. if s='' then
  521. exit;
  522. found:=FindLibraryFile(s,target_info.staticclibprefix,target_info.staticclibext,ns);
  523. if not(cs_link_nolink in current_settings.globalswitches) and (not found) then
  524. Message1(exec_w_libfile_not_found,s);
  525. StaticLibFiles.Concat(ns);
  526. end;
  527. procedure TLinker.InitSysInitUnitName;
  528. begin
  529. end;
  530. function TLinker.MakeExecutable:boolean;
  531. begin
  532. MakeExecutable:=false;
  533. Message(exec_e_exe_not_supported);
  534. end;
  535. Function TLinker.MakeSharedLibrary:boolean;
  536. begin
  537. MakeSharedLibrary:=false;
  538. Message(exec_e_dll_not_supported);
  539. end;
  540. Function TLinker.MakeStaticLibrary:boolean;
  541. begin
  542. MakeStaticLibrary:=false;
  543. Message(exec_e_static_lib_not_supported);
  544. end;
  545. Procedure TLinker.ExpandAndApplyOrder(var Src:TCmdStrList);
  546. var
  547. p : TLinkStrMap;
  548. i : longint;
  549. begin
  550. // call Virtual TLinker method to initialize
  551. LoadPredefinedLibraryOrder;
  552. // something to do?
  553. if (LinkLibraryAliases.count=0) and (LinkLibraryOrder.Count=0) Then
  554. exit;
  555. p:=TLinkStrMap.Create;
  556. // expand libaliases, clears src
  557. LinkLibraryAliases.expand(src,p);
  558. // writeln(src.count,' ',p.count,' ',linklibraryorder.count,' ',linklibraryaliases.count);
  559. // apply order
  560. p.UpdateWeights(LinkLibraryOrder);
  561. p.SortOnWeight;
  562. // put back in src
  563. for i:=0 to p.count-1 do
  564. src.insert(p[i].Key);
  565. p.free;
  566. end;
  567. procedure TLinker.LoadPredefinedLibraryOrder;
  568. begin
  569. end;
  570. function TLinker.ReOrderEntries : boolean;
  571. begin
  572. result:=(LinkLibraryOrder.count>0) or (LinkLibraryAliases.count>0);
  573. end;
  574. {*****************************************************************************
  575. TEXTERNALLINKER
  576. *****************************************************************************}
  577. Function TExternalLinker.WriteSymbolOrderFile: TCmdStr;
  578. var
  579. item: TCmdStrListItem;
  580. symfile: TScript;
  581. begin
  582. result:='';
  583. { only for darwin for now; can also enable for other platforms when using
  584. the LLVM linker }
  585. if (OrderedSymbols.Empty) or
  586. not(tf_supports_symbolorderfile in target_info.flags) then
  587. exit;
  588. symfile:=TScript.Create(outputexedir+UniqueName('symbol_order')+'.fpc');
  589. item:=TCmdStrListItem(OrderedSymbols.First);
  590. while assigned(item) do
  591. begin
  592. symfile.add(item.str);
  593. item:=TCmdStrListItem(item.next);
  594. end;
  595. symfile.WriteToDisk;
  596. result:=symfile.fn;
  597. symfile.Free;
  598. end;
  599. Function TExternalLinker.GetSanitizerLibName(const basename: TCmdStr; withArch: boolean): TCmdStr;
  600. begin
  601. result:=target_info.sharedClibprefix+'clang_rt.'+basename;
  602. if target_info.system in systems_darwin then
  603. begin
  604. { Darwin never adds the arch, it uses fat binaries. But it has the
  605. extra '_dynamic' for some reason, and also adds the platform type
  606. }
  607. if target_info.system in systems_macosx then
  608. result:=result+'_osx_dynamic'
  609. else if target_info.system in systems_ios then
  610. result:='_ios_dynamic'
  611. else if target_info.system in systems_iphonesim then
  612. result:='_iossim_dynamic'
  613. else
  614. internalerror(2022071010);
  615. end
  616. else
  617. begin
  618. if withArch then
  619. begin
  620. result:=result+'-'+tripletcpustr(triplet_llvmrt);
  621. if target_info.system in systems_android then
  622. result:=result+'-android';
  623. end;
  624. end;
  625. result:=result+target_info.sharedClibext;
  626. end;
  627. function TExternalLinker.AddSanitizerLibrariesAndGetSearchDir(const platformname: TCmdStr; out sanitizerlibrarydir: TCmdStr): boolean;
  628. var
  629. clang,
  630. clangsearchdirs,
  631. textline,
  632. clangsearchdirspath,
  633. sanitizerlibname,
  634. sanitizerlibrarypath: TCmdStr;
  635. sanitizerlibraryfiles: TCmdStrList;
  636. searchrec: TSearchRec;
  637. searchres: longint;
  638. clangsearchdirsfile: text;
  639. begin
  640. sanitizerlibraryfiles:=TCmdStrList.Create;
  641. result:=false;
  642. if (cs_sanitize_address in current_settings.moduleswitches) and
  643. not(cs_link_on_target in current_settings.globalswitches) then
  644. begin
  645. { ask clang }
  646. clang:=FindUtil('clang'+llvmutilssuffix);
  647. if clang<>'' then
  648. begin
  649. clangsearchdirspath:=outputexedir+UniqueName('clangsearchdirs');
  650. searchres:=shell(maybequoted(clang)+' -target '+targettriplet(triplet_llvm)+' -print-file-name=lib > '+maybequoted(clangsearchdirspath));
  651. if searchres=0 then
  652. begin
  653. AssignFile(clangsearchdirsfile,clangsearchdirspath);
  654. {$push}{$i-}
  655. reset(clangsearchdirsfile);
  656. {$pop}
  657. if ioresult=0 then
  658. begin
  659. readln(clangsearchdirsfile,textline);
  660. sanitizerlibrarydir:=FixFileName(textline+'/'+platformname);
  661. sanitizerlibrarypath:=FixFileName(sanitizerlibrarydir+'/');
  662. { from clang:
  663. Check for runtime files in the new layout without the architecture first.
  664. }
  665. sanitizerlibname:=GetSanitizerLibName('asan',false);
  666. result:=FileExists(sanitizerlibrarypath+sanitizerlibname,false);
  667. if result then
  668. begin
  669. sanitizerlibraryfiles.Concat(sanitizerlibrarypath+sanitizerlibname);
  670. end
  671. else
  672. begin
  673. sanitizerlibname:=GetSanitizerLibName('asan',true);
  674. result:=FileExists(sanitizerlibrarypath+sanitizerlibname,false);
  675. if result then
  676. sanitizerlibraryfiles.Concat(sanitizerlibrarypath+sanitizerlibname);
  677. end;
  678. end;
  679. end;
  680. if FileExists(clangsearchdirspath,false) then
  681. DeleteFile(clangsearchdirspath);
  682. end;
  683. end;
  684. if result then
  685. ObjectFiles.concatList(sanitizerlibraryfiles);
  686. sanitizerlibraryfiles.free;
  687. end;
  688. Constructor TExternalLinker.Create;
  689. begin
  690. inherited Create;
  691. { set generic defaults }
  692. FillChar(Info,sizeof(Info),0);
  693. if cs_link_on_target in current_settings.globalswitches then
  694. begin
  695. Info.ResName:=ChangeFileExt(inputfilename,'_link.res');
  696. Info.ScriptName:=ChangeFileExt(inputfilename,'_script.res');
  697. end
  698. else
  699. begin
  700. Info.ResName:=UniqueName('link')+'.res';
  701. Info.ScriptName:=UniqueName('script')+'.res';
  702. end;
  703. { set the linker specific defaults }
  704. SetDefaultInfo;
  705. { Allow Parameter overrides for linker info }
  706. with Info do
  707. begin
  708. if ParaLinkOptions<>'' then
  709. ExtraOptions:=ParaLinkOptions;
  710. if ParaDynamicLinker<>'' then
  711. DynamicLinker:=ParaDynamicLinker;
  712. end;
  713. end;
  714. Destructor TExternalLinker.Destroy;
  715. begin
  716. inherited destroy;
  717. end;
  718. Procedure TExternalLinker.SetDefaultInfo;
  719. begin
  720. end;
  721. Function TExternalLinker.FindUtil(const s:TCmdStr;throwerror: boolean=true):TCmdStr;
  722. var
  723. Found : boolean;
  724. FoundBin : TCmdStr;
  725. UtilExe : TCmdStr;
  726. begin
  727. if cs_link_on_target in current_settings.globalswitches then
  728. begin
  729. { If linking on target, don't add any path PM }
  730. { change extension only on platforms that use an exe extension, otherwise on OpenBSD 'ld.bfd' gets
  731. converted to 'ld' }
  732. if target_info.exeext<>'' then
  733. FindUtil:=ChangeFileExt(s,target_info.exeext)
  734. else
  735. FindUtil:=s;
  736. exit;
  737. end;
  738. { change extension only on platforms that use an exe extension, otherwise on OpenBSD 'ld.bfd' gets converted
  739. to 'ld' }
  740. if source_info.exeext<>'' then
  741. UtilExe:=ChangeFileExt(s,source_info.exeext)
  742. else
  743. UtilExe:=s;
  744. FoundBin:='';
  745. Found:=false;
  746. if utilsdirectory<>'' then
  747. Found:=FindFile(utilexe,utilsdirectory,false,Foundbin);
  748. if (not Found) then
  749. Found:=FindExe(utilexe,false,Foundbin);
  750. if throwerror and (not Found) and not(cs_link_nolink in current_settings.globalswitches) then
  751. begin
  752. Message1(exec_e_util_not_found,utilexe);
  753. current_settings.globalswitches:=current_settings.globalswitches+[cs_link_nolink];
  754. end;
  755. if (FoundBin<>'') then
  756. Message1(exec_t_using_util,FoundBin);
  757. FindUtil:=FoundBin;
  758. end;
  759. Function TExternalLinker.CatFileContent(para : TCmdStr) : TCmdStr;
  760. var
  761. filecontent : TCmdStr;
  762. f : text;
  763. st : TCmdStr;
  764. begin
  765. if not (tf_no_backquote_support in source_info.flags) or
  766. (cs_link_on_target in current_settings.globalswitches) then
  767. begin
  768. CatFileContent:='`cat '+MaybeQuoted(para)+'`';
  769. Exit;
  770. end;
  771. assign(f,para);
  772. filecontent:='';
  773. {$push}{$I-}
  774. reset(f);
  775. {$pop}
  776. if IOResult<>0 then
  777. begin
  778. Message1(exec_n_backquote_cat_file_not_found,para);
  779. end
  780. else
  781. begin
  782. while not eof(f) do
  783. begin
  784. readln(f,st);
  785. if st<>'' then
  786. filecontent:=filecontent+' '+st;
  787. end;
  788. close(f);
  789. end;
  790. CatFileContent:=filecontent;
  791. end;
  792. Function TExternalLinker.DoExec(const command:TCmdStr; para:TCmdStr;showinfo,useshell:boolean):boolean;
  793. var
  794. exitcode: longint;
  795. begin
  796. DoExec:=true;
  797. if not(cs_link_nolink in current_settings.globalswitches) then
  798. begin
  799. FlushOutput;
  800. if useshell then
  801. exitcode:=shell(maybequoted(command)+' '+para)
  802. else
  803. try
  804. exitcode:=RequotedExecuteProcess(command,para);
  805. except on E:EOSError do
  806. begin
  807. Message1(exec_e_cant_call_linker,e.Message);
  808. current_settings.globalswitches:=current_settings.globalswitches+[cs_link_nolink];
  809. DoExec:=false;
  810. end;
  811. end;
  812. if (exitcode<>0) then
  813. begin
  814. Message(exec_e_error_while_linking);
  815. current_settings.globalswitches:=current_settings.globalswitches+[cs_link_nolink];
  816. DoExec:=false;
  817. end;
  818. end;
  819. { Update asmres when externmode is set }
  820. if cs_link_nolink in current_settings.globalswitches then
  821. begin
  822. if showinfo then
  823. begin
  824. if current_module.islibrary then
  825. AsmRes.AddLinkCommand(Command,Para,current_module.sharedlibfilename)
  826. else
  827. AsmRes.AddLinkCommand(Command,Para,current_module.exefilename);
  828. end
  829. else
  830. AsmRes.AddLinkCommand(Command,Para,'');
  831. end;
  832. end;
  833. Function TExternalLinker.MakeStaticLibrary:boolean;
  834. var
  835. total_size, power : longint;
  836. function GetNextFiles(const maxCmdLength : Longint; var item : TCmdStrListItem; const addfilecmd : string) : TCmdStr;
  837. var
  838. ItemExists : boolean;
  839. ItemSize : longint;
  840. fs : file;
  841. begin
  842. result := '';
  843. while (assigned(item) and ((length(result) + length(item.str) + 1) < maxCmdLength)) do begin
  844. ItemExists:=FileExists(FixFilename(item.str),true);
  845. ItemSize:=0;
  846. if ItemExists then
  847. begin
  848. system.assign(fs,item.str);
  849. system.reset(fs);
  850. ItemSize:=FileSize(fs);
  851. system.close(fs);
  852. system.inc(total_size,align(ItemSize,16));
  853. end;
  854. if (cs_link_nolink in current_settings.globalswitches) or
  855. (ItemExists and (ItemSize>0)) then
  856. result := result + ' ' + addfilecmd + item.str;
  857. item := TCmdStrListItem(item.next);
  858. end;
  859. end;
  860. function get_wlib_record_size: integer;
  861. var
  862. nb_pages,page_size : longint;
  863. begin
  864. { Set wlib page size to a sensible value }
  865. if total_size>0 then
  866. begin
  867. page_size:=16 div 2;
  868. repeat
  869. page_size:=page_size*2;
  870. nb_pages:=(total_size + (page_size-1)*SmartLinkOFiles.count) div page_size;
  871. until nb_pages <= high(word);
  872. result:=nb_pages;
  873. end
  874. else
  875. result:=max(16,nextpowerof2(SmartLinkOFiles.count div 16, power));
  876. end;
  877. var
  878. binstr, firstbinstr, scriptfile : TCmdStr;
  879. cmdstr, firstcmd, nextcmd, smartpath : TCmdStr;
  880. current : TCmdStrListItem;
  881. script: Text;
  882. scripted_ar : boolean;
  883. ar_creates_different_output_file : boolean;
  884. success : boolean;
  885. first : boolean;
  886. begin
  887. MakeStaticLibrary:=false;
  888. total_size:=0;
  889. { remove the library, to be sure that it is rewritten }
  890. DeleteFile(current_module.staticlibfilename);
  891. { Call AR }
  892. smartpath:=FixPath(ChangeFileExt(current_module.asmfilename,target_info.smartext),false);
  893. SplitBinCmd(target_ar.arcmd,binstr,cmdstr);
  894. binstr := FindUtil(utilsprefix + binstr);
  895. if target_ar.arfirstcmd<>'' then
  896. begin
  897. SplitBinCmd(target_ar.arfirstcmd,firstbinstr,firstcmd);
  898. firstbinstr := FindUtil(utilsprefix + firstbinstr);
  899. end
  900. else
  901. begin
  902. firstbinstr:=binstr;
  903. firstcmd:=cmdstr;
  904. end;
  905. scripted_ar:=(target_ar.id=ar_gnu_ar_scripted) or
  906. (target_ar.id=ar_watcom_wlib_omf_scripted) or
  907. (target_ar.id=ar_sdcc_sdar_scripted);
  908. if scripted_ar then
  909. begin
  910. scriptfile := FixFileName(smartpath+'arscript.txt');
  911. Replace(cmdstr,'$SCRIPT',maybequoted(scriptfile));
  912. Assign(script, scriptfile);
  913. Rewrite(script);
  914. try
  915. if (target_ar.id in [ar_gnu_ar_scripted,ar_sdcc_sdar_scripted]) then
  916. writeln(script, 'CREATE ' + current_module.staticlibfilename)
  917. else { wlib case }
  918. writeln(script,'-q -p=',get_wlib_record_size,' -fo -c -b '+
  919. maybequoted(current_module.staticlibfilename));
  920. current := TCmdStrListItem(SmartLinkOFiles.First);
  921. while current <> nil do
  922. begin
  923. if (target_ar.id in [ar_gnu_ar_scripted,ar_sdcc_sdar_scripted]) then
  924. writeln(script, 'ADDMOD ' + current.str)
  925. else
  926. writeln(script,'+' + current.str);
  927. current := TCmdStrListItem(current.next);
  928. end;
  929. if (target_ar.id in [ar_gnu_ar_scripted,ar_sdcc_sdar_scripted]) then
  930. begin
  931. writeln(script, 'SAVE');
  932. writeln(script, 'END');
  933. end;
  934. finally
  935. Close(script);
  936. end;
  937. success:=DoExec(binstr,cmdstr,false,true);
  938. end
  939. else
  940. begin
  941. ar_creates_different_output_file:=(Pos('$OUTPUTLIB',cmdstr)>0) or (Pos('$OUTPUTLIB',firstcmd)>0);
  942. Replace(cmdstr,'$LIB',maybequoted(current_module.staticlibfilename));
  943. Replace(firstcmd,'$LIB',maybequoted(current_module.staticlibfilename));
  944. Replace(cmdstr,'$OUTPUTLIB',maybequoted(current_module.staticlibfilename+'.tmp'));
  945. Replace(firstcmd,'$OUTPUTLIB',maybequoted(current_module.staticlibfilename+'.tmp'));
  946. if target_ar.id=ar_watcom_wlib_omf then
  947. begin
  948. Replace(cmdstr,'$RECSIZE','-p='+IntToStr(get_wlib_record_size));
  949. Replace(firstcmd,'$RECSIZE','-p='+IntToStr(get_wlib_record_size));
  950. end;
  951. { create AR commands }
  952. success := true;
  953. current := TCmdStrListItem(SmartLinkOFiles.First);
  954. first := true;
  955. repeat
  956. if first then
  957. nextcmd := firstcmd
  958. else
  959. nextcmd := cmdstr;
  960. Replace(nextcmd,'$FILES',GetNextFiles(2047, current, target_ar.addfilecmd));
  961. if first then
  962. success:=DoExec(firstbinstr,nextcmd,false,true)
  963. else
  964. success:=DoExec(binstr,nextcmd,false,true);
  965. if ar_creates_different_output_file then
  966. begin
  967. if FileExists(current_module.staticlibfilename,false) then
  968. DeleteFile(current_module.staticlibfilename);
  969. if FileExists(current_module.staticlibfilename+'.tmp',false) then
  970. RenameFile(current_module.staticlibfilename+'.tmp',current_module.staticlibfilename);
  971. end;
  972. first := false;
  973. until (not assigned(current)) or (not success);
  974. end;
  975. if (target_ar.arfinishcmd <> '') then
  976. begin
  977. SplitBinCmd(target_ar.arfinishcmd,binstr,cmdstr);
  978. binstr := FindUtil(utilsprefix + binstr);
  979. Replace(cmdstr,'$LIB',maybequoted(current_module.staticlibfilename));
  980. success:=DoExec(binstr,cmdstr,false,true);
  981. end;
  982. { Clean up }
  983. if not(cs_asm_leave in current_settings.globalswitches) then
  984. if not(cs_link_nolink in current_settings.globalswitches) then
  985. begin
  986. while not SmartLinkOFiles.Empty do
  987. DeleteFile(SmartLinkOFiles.GetFirst);
  988. if scripted_ar then
  989. DeleteFile(scriptfile);
  990. RemoveDir(smartpath);
  991. end
  992. else
  993. begin
  994. while not SmartLinkOFiles.Empty do
  995. AsmRes.AddDeleteCommand(SmartLinkOFiles.GetFirst);
  996. if scripted_ar then
  997. AsmRes.AddDeleteCommand(scriptfile);
  998. AsmRes.AddDeleteDirCommand(smartpath);
  999. end;
  1000. MakeStaticLibrary:=success;
  1001. end;
  1002. function TExternalLinker.UniqueName(const str: TCmdStr): TCmdStr;
  1003. const
  1004. pid: SizeUInt = 0;
  1005. begin
  1006. if pid=0 then
  1007. pid:=GetProcessID;
  1008. if pid>0 then
  1009. result:=str+tostr(pid)
  1010. else
  1011. result:=str;
  1012. end;
  1013. function TExternalLinker.PostProcessELFExecutable(const fn : string;isdll:boolean):boolean;
  1014. type
  1015. TElf32header=packed record
  1016. magic0123 : array[0..3] of char;
  1017. file_class : byte;
  1018. data_encoding : byte;
  1019. file_version : byte;
  1020. padding : array[$07..$0f] of byte;
  1021. e_type : word;
  1022. e_machine : word;
  1023. e_version : longint;
  1024. e_entry : longint; { entrypoint }
  1025. e_phoff : longint; { program header offset }
  1026. e_shoff : longint; { sections header offset }
  1027. e_flags : longint;
  1028. e_ehsize : word; { elf header size in bytes }
  1029. e_phentsize : word; { size of an entry in the program header array }
  1030. e_phnum : word; { 0..e_phnum-1 of entrys }
  1031. e_shentsize : word; { size of an entry in sections header array }
  1032. e_shnum : word; { 0..e_shnum-1 of entrys }
  1033. e_shstrndx : word; { index of string section header }
  1034. end;
  1035. TElf32sechdr=packed record
  1036. sh_name : longint;
  1037. sh_type : longint;
  1038. sh_flags : longint;
  1039. sh_addr : longint;
  1040. sh_offset : longint;
  1041. sh_size : longint;
  1042. sh_link : longint;
  1043. sh_info : longint;
  1044. sh_addralign : longint;
  1045. sh_entsize : longint;
  1046. end;
  1047. telf64header=packed record
  1048. magic0123 : array[0..3] of char;
  1049. file_class : byte;
  1050. data_encoding : byte;
  1051. file_version : byte;
  1052. padding : array[$07..$0f] of byte;
  1053. e_type : word;
  1054. e_machine : word;
  1055. e_version : longword;
  1056. e_entry : qword; { entrypoint }
  1057. e_phoff : qword; { program header offset }
  1058. e_shoff : qword; { sections header offset }
  1059. e_flags : longword;
  1060. e_ehsize : word; { elf header size in bytes }
  1061. e_phentsize : word; { size of an entry in the program header array }
  1062. e_phnum : word; { 0..e_phnum-1 of entrys }
  1063. e_shentsize : word; { size of an entry in sections header array }
  1064. e_shnum : word; { 0..e_shnum-1 of entrys }
  1065. e_shstrndx : word; { index of string section header }
  1066. end;
  1067. TElf64sechdr=packed record
  1068. sh_name : longword;
  1069. sh_type : longword;
  1070. sh_flags : qword;
  1071. sh_addr : qword;
  1072. sh_offset : qword;
  1073. sh_size : qword;
  1074. sh_link : longword;
  1075. sh_info : longword;
  1076. sh_addralign : qword;
  1077. sh_entsize : qword;
  1078. end;
  1079. function MayBeSwapHeader(h : telf32header) : telf32header;
  1080. begin
  1081. result:=h;
  1082. if source_info.endian<>target_info.endian then
  1083. with h do
  1084. begin
  1085. result.e_type:=swapendian(e_type);
  1086. result.e_machine:=swapendian(e_machine);
  1087. result.e_version:=swapendian(e_version);
  1088. result.e_entry:=swapendian(e_entry);
  1089. result.e_phoff:=swapendian(e_phoff);
  1090. result.e_shoff:=swapendian(e_shoff);
  1091. result.e_flags:=swapendian(e_flags);
  1092. result.e_ehsize:=swapendian(e_ehsize);
  1093. result.e_phentsize:=swapendian(e_phentsize);
  1094. result.e_phnum:=swapendian(e_phnum);
  1095. result.e_shentsize:=swapendian(e_shentsize);
  1096. result.e_shnum:=swapendian(e_shnum);
  1097. result.e_shstrndx:=swapendian(e_shstrndx);
  1098. end;
  1099. end;
  1100. function MayBeSwapHeader(h : telf64header) : telf64header;
  1101. begin
  1102. result:=h;
  1103. if source_info.endian<>target_info.endian then
  1104. with h do
  1105. begin
  1106. result.e_type:=swapendian(e_type);
  1107. result.e_machine:=swapendian(e_machine);
  1108. result.e_version:=swapendian(e_version);
  1109. result.e_entry:=swapendian(e_entry);
  1110. result.e_phoff:=swapendian(e_phoff);
  1111. result.e_shoff:=swapendian(e_shoff);
  1112. result.e_flags:=swapendian(e_flags);
  1113. result.e_ehsize:=swapendian(e_ehsize);
  1114. result.e_phentsize:=swapendian(e_phentsize);
  1115. result.e_phnum:=swapendian(e_phnum);
  1116. result.e_shentsize:=swapendian(e_shentsize);
  1117. result.e_shnum:=swapendian(e_shnum);
  1118. result.e_shstrndx:=swapendian(e_shstrndx);
  1119. end;
  1120. end;
  1121. function MaybeSwapSecHeader(h : telf32sechdr) : telf32sechdr;
  1122. begin
  1123. result:=h;
  1124. if source_info.endian<>target_info.endian then
  1125. with h do
  1126. begin
  1127. result.sh_name:=swapendian(sh_name);
  1128. result.sh_type:=swapendian(sh_type);
  1129. result.sh_flags:=swapendian(sh_flags);
  1130. result.sh_addr:=swapendian(sh_addr);
  1131. result.sh_offset:=swapendian(sh_offset);
  1132. result.sh_size:=swapendian(sh_size);
  1133. result.sh_link:=swapendian(sh_link);
  1134. result.sh_info:=swapendian(sh_info);
  1135. result.sh_addralign:=swapendian(sh_addralign);
  1136. result.sh_entsize:=swapendian(sh_entsize);
  1137. end;
  1138. end;
  1139. function MaybeSwapSecHeader(h : telf64sechdr) : telf64sechdr;
  1140. begin
  1141. result:=h;
  1142. if source_info.endian<>target_info.endian then
  1143. with h do
  1144. begin
  1145. result.sh_name:=swapendian(sh_name);
  1146. result.sh_type:=swapendian(sh_type);
  1147. result.sh_flags:=swapendian(sh_flags);
  1148. result.sh_addr:=swapendian(sh_addr);
  1149. result.sh_offset:=swapendian(sh_offset);
  1150. result.sh_size:=swapendian(sh_size);
  1151. result.sh_link:=swapendian(sh_link);
  1152. result.sh_info:=swapendian(sh_info);
  1153. result.sh_addralign:=swapendian(sh_addralign);
  1154. result.sh_entsize:=swapendian(sh_entsize);
  1155. end;
  1156. end;
  1157. var
  1158. f : file;
  1159. function ReadSectionName(pos : longint) : String;
  1160. var
  1161. oldpos : longint;
  1162. c : char;
  1163. begin
  1164. oldpos:=filepos(f);
  1165. seek(f,pos);
  1166. Result:='';
  1167. while true do
  1168. begin
  1169. blockread(f,c,1);
  1170. if c=#0 then
  1171. break;
  1172. Result:=Result+c;
  1173. end;
  1174. seek(f,oldpos);
  1175. end;
  1176. var
  1177. elfheader32 : TElf32header;
  1178. secheader32 : TElf32sechdr;
  1179. elfheader64 : TElf64header;
  1180. secheader64 : TElf64sechdr;
  1181. i : longint;
  1182. stringoffset : longint;
  1183. secname : string;
  1184. begin
  1185. Result:=false;
  1186. { open file }
  1187. assign(f,fn);
  1188. {$push}{$I-}
  1189. reset(f,1);
  1190. if ioresult<>0 then
  1191. Message1(execinfo_f_cant_open_executable,fn);
  1192. { read header }
  1193. blockread(f,elfheader32,sizeof(tElf32header));
  1194. with elfheader32 do
  1195. if not((magic0123[0]=#$7f) and (magic0123[1]='E') and (magic0123[2]='L') and (magic0123[3]='F')) then
  1196. Exit;
  1197. case elfheader32.file_class of
  1198. 1:
  1199. begin
  1200. elfheader32:=MayBeSwapHeader(elfheader32);
  1201. seek(f,elfheader32.e_shoff);
  1202. { read string section header }
  1203. seek(f,elfheader32.e_shoff+sizeof(TElf32sechdr)*elfheader32.e_shstrndx);
  1204. blockread(f,secheader32,sizeof(secheader32));
  1205. secheader32:=MaybeSwapSecHeader(secheader32);
  1206. stringoffset:=secheader32.sh_offset;
  1207. seek(f,elfheader32.e_shoff);
  1208. status.datasize:=0;
  1209. for i:=0 to elfheader32.e_shnum-1 do
  1210. begin
  1211. blockread(f,secheader32,sizeof(secheader32));
  1212. secheader32:=MaybeSwapSecHeader(secheader32);
  1213. secname:=ReadSectionName(stringoffset+secheader32.sh_name);
  1214. case secname of
  1215. '.text':
  1216. begin
  1217. Message1(execinfo_x_codesize,tostr(secheader32.sh_size));
  1218. status.codesize:=secheader32.sh_size;
  1219. end;
  1220. '.fpcdata',
  1221. '.rodata',
  1222. '.data':
  1223. begin
  1224. Message1(execinfo_x_initdatasize,tostr(secheader32.sh_size));
  1225. inc(status.datasize,secheader32.sh_size);
  1226. end;
  1227. '.bss':
  1228. begin
  1229. Message1(execinfo_x_uninitdatasize,tostr(secheader32.sh_size));
  1230. inc(status.datasize,secheader32.sh_size);
  1231. end;
  1232. end;
  1233. end;
  1234. end;
  1235. 2:
  1236. begin
  1237. seek(f,0);
  1238. blockread(f,elfheader64,sizeof(tElf64header));
  1239. with elfheader64 do
  1240. if not((magic0123[0]=#$7f) and (magic0123[1]='E') and (magic0123[2]='L') and (magic0123[3]='F')) then
  1241. Exit;
  1242. elfheader64:=MayBeSwapHeader(elfheader64);
  1243. seek(f,elfheader64.e_shoff);
  1244. { read string section header }
  1245. seek(f,elfheader64.e_shoff+sizeof(TElf64sechdr)*elfheader64.e_shstrndx);
  1246. blockread(f,secheader64,sizeof(secheader64));
  1247. secheader64:=MaybeSwapSecHeader(secheader64);
  1248. stringoffset:=secheader64.sh_offset;
  1249. seek(f,elfheader64.e_shoff);
  1250. status.datasize:=0;
  1251. for i:=0 to elfheader64.e_shnum-1 do
  1252. begin
  1253. blockread(f,secheader64,sizeof(secheader64));
  1254. secheader64:=MaybeSwapSecHeader(secheader64);
  1255. secname:=ReadSectionName(stringoffset+secheader64.sh_name);
  1256. case secname of
  1257. '.text':
  1258. begin
  1259. Message1(execinfo_x_codesize,tostr(secheader64.sh_size));
  1260. status.codesize:=secheader64.sh_size;
  1261. end;
  1262. '.fpcdata',
  1263. '.rodata',
  1264. '.data':
  1265. begin
  1266. Message1(execinfo_x_initdatasize,tostr(secheader64.sh_size));
  1267. inc(status.datasize,secheader64.sh_size);
  1268. end;
  1269. '.bss':
  1270. begin
  1271. Message1(execinfo_x_uninitdatasize,tostr(secheader64.sh_size));
  1272. inc(status.datasize,secheader64.sh_size);
  1273. end;
  1274. end;
  1275. end;
  1276. end;
  1277. else
  1278. exit;
  1279. end;
  1280. close(f);
  1281. {$pop}
  1282. if ioresult<>0 then
  1283. ;
  1284. Result:=true;
  1285. end;
  1286. function TExternalLinker.PostProcessMachExecutable(const fn : string;isdll:boolean):boolean;
  1287. type
  1288. TMachHeader=record
  1289. magic : longword;
  1290. cputype : integer;
  1291. cpusubtype : integer;
  1292. filetype : longword;
  1293. ncmds : longword;
  1294. sizeofcmds : longword;
  1295. flags : longword;
  1296. reserved : longword;
  1297. end;
  1298. TMachLoadCommand = record
  1299. cmd : longword;
  1300. cmdsize : longword;
  1301. end;
  1302. TMachSegmentCommand64 = record
  1303. segname : array[0..15] of char;
  1304. vmaddr : qword;
  1305. vmsize : qword;
  1306. fileoff : qword;
  1307. filesize : qword;
  1308. maxprot : integer;
  1309. initprot : integer;
  1310. nsects : dword;
  1311. flags : dword;
  1312. end;
  1313. var
  1314. f : file;
  1315. machheader : TMachHeader;
  1316. machloadcmd : TMachLoadCommand;
  1317. machsegmentcommand64 :TMachSegmentCommand64;
  1318. i : longint;
  1319. begin
  1320. Result:=false;
  1321. { open file }
  1322. assign(f,fn);
  1323. {$push}{$I-}
  1324. reset(f,1);
  1325. if ioresult<>0 then
  1326. Message1(execinfo_f_cant_open_executable,fn);
  1327. {$ifdef DEBUG_MACHO_INFO}
  1328. writeln('Start reading Mach-O file');
  1329. {$endif DEBUG_MACHO_INFO}
  1330. blockread(f,machheader,sizeof(TMachHeader));
  1331. if machheader.magic<>$feedfacf then
  1332. Exit;
  1333. {$ifdef DEBUG_MACHO_INFO}
  1334. writeln('Magic header recognized (64 Bit, Little Endian)');
  1335. writeln('Reading ',machheader.ncmds,' commands');
  1336. {$endif DEBUG_MACHO_INFO}
  1337. for i:=1 to machheader.ncmds do
  1338. begin
  1339. blockread(f,machloadcmd,sizeof(machloadcmd));
  1340. case machloadcmd.cmd of
  1341. $19:
  1342. begin
  1343. blockread(f,machsegmentcommand64,sizeof(machsegmentcommand64));
  1344. {$ifdef DEBUG_MACHO_INFO}
  1345. writeln('Found SegmentCommand64: Name = ',StrPas(@machsegmentcommand64.segname),
  1346. '; VMSize = $',hexstr(machsegmentcommand64.vmsize,8),
  1347. '; FileSize = $',hexstr(machsegmentcommand64.filesize,8));
  1348. {$endif DEBUG_MACHO_INFO}
  1349. case StrPas(@machsegmentcommand64.segname) of
  1350. '__TEXT':
  1351. begin
  1352. Message1(execinfo_x_codesize,tostr(machsegmentcommand64.vmsize));
  1353. status.codesize:=machsegmentcommand64.vmsize;
  1354. end;
  1355. '__DATA_CONST':
  1356. begin
  1357. Message1(execinfo_x_initdatasize,tostr(machsegmentcommand64.vmsize));
  1358. inc(status.datasize,machsegmentcommand64.vmsize);
  1359. end;
  1360. '__DATA':
  1361. begin
  1362. Message1(execinfo_x_uninitdatasize,tostr(machsegmentcommand64.vmsize));
  1363. inc(status.datasize,machsegmentcommand64.vmsize);
  1364. end;
  1365. end;
  1366. Seek(f,FilePos(f)+machloadcmd.cmdsize-sizeof(machloadcmd)-sizeof(machsegmentcommand64));
  1367. end;
  1368. else
  1369. begin
  1370. {$ifdef DEBUG_MACHO_INFO}
  1371. writeln('Found Load Command: $',hexstr(machloadcmd.cmd,4),', skipping');
  1372. {$endif DEBUG_MACHO_INFO}
  1373. Seek(f,FilePos(f)+machloadcmd.cmdsize-sizeof(machloadcmd));
  1374. end;
  1375. end;
  1376. end;
  1377. close(f);
  1378. {$pop}
  1379. if ioresult<>0 then
  1380. ;
  1381. Result:=true;
  1382. end;
  1383. {*****************************************************************************
  1384. TINTERNALLINKER
  1385. *****************************************************************************}
  1386. Constructor TInternalLinker.Create;
  1387. begin
  1388. inherited Create;
  1389. linkscript:=TCmdStrList.Create;
  1390. FStaticLibraryList:=TFPObjectList.Create(true);
  1391. FImportLibraryList:=TFPHashObjectList.Create(true);
  1392. FGroupStack:=TFPObjectList.Create(false);
  1393. exemap:=nil;
  1394. exeoutput:=nil;
  1395. UseStabs:=false;
  1396. CObjInput:=TObjInput;
  1397. ScriptCount:=0;
  1398. IsHandled:=nil;
  1399. end;
  1400. Destructor TInternalLinker.Destroy;
  1401. begin
  1402. FGroupStack.Free;
  1403. linkscript.free;
  1404. StaticLibraryList.Free;
  1405. ImportLibraryList.Free;
  1406. if assigned(IsHandled) then
  1407. begin
  1408. FreeMem(IsHandled,sizeof(boolean)*ScriptCount);
  1409. IsHandled:=nil;
  1410. ScriptCount:=0;
  1411. end;
  1412. if assigned(exeoutput) then
  1413. begin
  1414. exeoutput.free;
  1415. exeoutput:=nil;
  1416. end;
  1417. if assigned(exemap) then
  1418. begin
  1419. exemap.free;
  1420. exemap:=nil;
  1421. end;
  1422. inherited destroy;
  1423. end;
  1424. procedure TInternalLinker.AddImportSymbol(const libname,symname,symmangledname:TCmdStr;OrdNr: longint;isvar:boolean);
  1425. var
  1426. ImportLibrary : TImportLibrary;
  1427. ImportSymbol : TFPHashObject;
  1428. begin
  1429. ImportLibrary:=TImportLibrary(ImportLibraryList.Find(libname));
  1430. if not assigned(ImportLibrary) then
  1431. ImportLibrary:=TImportLibrary.Create(ImportLibraryList,libname);
  1432. ImportSymbol:=TFPHashObject(ImportLibrary.ImportSymbolList.Find(symname));
  1433. if not assigned(ImportSymbol) then
  1434. ImportSymbol:=TImportSymbol.Create(ImportLibrary.ImportSymbolList,symname,symmangledname,OrdNr,isvar);
  1435. end;
  1436. procedure TInternalLinker.ScriptAddSourceStatements(AddSharedAsStatic:boolean);
  1437. var
  1438. s,s2: TCmdStr;
  1439. begin
  1440. while not ObjectFiles.Empty do
  1441. begin
  1442. s:=ObjectFiles.GetFirst;
  1443. if s<>'' then
  1444. LinkScript.Concat('READOBJECT '+MaybeQuoted(s));
  1445. end;
  1446. while not StaticLibFiles.Empty do
  1447. begin
  1448. s:=StaticLibFiles.GetFirst;
  1449. if s<>'' then
  1450. LinkScript.Concat('READSTATICLIBRARY '+MaybeQuoted(s));
  1451. end;
  1452. if not AddSharedAsStatic then
  1453. exit;
  1454. while not SharedLibFiles.Empty do
  1455. begin
  1456. S:=SharedLibFiles.GetFirst;
  1457. if FindLibraryFile(s,target_info.staticClibprefix,target_info.staticClibext,s2) then
  1458. LinkScript.Concat('READSTATICLIBRARY '+MaybeQuoted(s2))
  1459. else
  1460. Comment(V_Error,'Import library not found for '+S);
  1461. end;
  1462. end;
  1463. function TInternalLinker.GetCodeSize(aExeOutput: TExeOutput): QWord;
  1464. begin
  1465. Result:=aExeOutput.findexesection('.text').size;
  1466. end;
  1467. function TInternalLinker.GetDataSize(aExeOutput: TExeOutput): QWord;
  1468. begin
  1469. Result:=aExeOutput.findexesection('.data').size;
  1470. end;
  1471. function TInternalLinker.GetBssSize(aExeOutput: TExeOutput): QWord;
  1472. var
  1473. bsssec: TExeSection;
  1474. begin
  1475. bsssec:=aExeOutput.findexesection('.bss');
  1476. if assigned(bsssec) then
  1477. Result:=bsssec.size
  1478. else
  1479. Result:=0;
  1480. end;
  1481. procedure TInternalLinker.ParseLdScript(src:TScriptLexer);
  1482. var
  1483. asneeded: boolean;
  1484. group: TStaticLibrary;
  1485. procedure ParseInputList;
  1486. var
  1487. saved_asneeded: boolean;
  1488. begin
  1489. src.Expect('(');
  1490. repeat
  1491. if src.CheckForIdent('AS_NEEDED') then
  1492. begin
  1493. saved_asneeded:=asneeded;
  1494. asneeded:=true;
  1495. ParseInputList;
  1496. asneeded:=saved_asneeded;
  1497. end
  1498. else if src.token in [tkIDENT,tkLITERAL] then
  1499. begin
  1500. Load_ReadStaticLibrary(src.tokenstr,asneeded);
  1501. src.nextToken;
  1502. end
  1503. else if src.CheckFor('-') then
  1504. begin
  1505. { TODO: no whitespace between '-' and name;
  1506. name must begin with 'l' }
  1507. src.nextToken;
  1508. end
  1509. else { syntax error, no input_list_element term }
  1510. Break;
  1511. if src.CheckFor(',') then
  1512. Continue;
  1513. until src.CheckFor(')');
  1514. end;
  1515. begin
  1516. asneeded:=false;
  1517. src.nextToken;
  1518. repeat
  1519. if src.CheckForIdent('OUTPUT_FORMAT') then
  1520. begin
  1521. src.Expect('(');
  1522. //writeln('output_format(',src.tokenstr,')');
  1523. src.nextToken;
  1524. src.Expect(')');
  1525. end
  1526. else if src.CheckForIdent('GROUP') then
  1527. begin
  1528. group:=TStaticLibrary.create_group;
  1529. TFPObjectList(FGroupStack.Last).Add(group);
  1530. FGroupStack.Add(group.GroupMembers);
  1531. ParseInputList;
  1532. FGroupStack.Delete(FGroupStack.Count-1);
  1533. end
  1534. else if src.CheckFor(';') then
  1535. {skip semicolon};
  1536. until src.token in [tkEOF,tkINVALID];
  1537. end;
  1538. procedure TInternalLinker.Load_ReadObject(const para:TCmdStr);
  1539. var
  1540. objdata : TObjData;
  1541. objinput : TObjinput;
  1542. objreader : TObjectReader;
  1543. fn : TCmdStr;
  1544. begin
  1545. fn:=FindObjectFile(para,'',false);
  1546. Comment(V_Tried,'Reading object '+fn);
  1547. objinput:=CObjInput.Create;
  1548. objreader:=TObjectreader.create;
  1549. if objreader.openfile(fn) then
  1550. begin
  1551. if objinput.ReadObjData(objreader,objdata) then
  1552. exeoutput.addobjdata(objdata);
  1553. end;
  1554. { release input object }
  1555. objinput.free;
  1556. objreader.free;
  1557. end;
  1558. procedure TInternalLinker.Load_ReadStaticLibrary(const para:TCmdStr;asneededflag:boolean);
  1559. var
  1560. objreader : TObjectReader;
  1561. objinput: TObjInput;
  1562. objdata: TObjData;
  1563. ScriptLexer: TScriptLexer;
  1564. stmt:TStaticLibrary;
  1565. begin
  1566. { TODO: Cleanup ignoring of FPC generated libimp*.a files}
  1567. { Don't load import libraries }
  1568. if copy(ExtractFileName(para),1,6)='libimp' then
  1569. exit;
  1570. Comment(V_Tried,'Opening library '+para);
  1571. objreader:=CArObjectreader.createAr(para,true);
  1572. if ErrorCount>0 then
  1573. exit;
  1574. if objreader.isarchive then
  1575. TFPObjectList(FGroupStack.Last).Add(TStaticLibrary.Create(para,objreader,CObjInput))
  1576. else
  1577. if CObjInput.CanReadObjData(objreader) then
  1578. begin
  1579. { may be a regular object as well as a dynamic one }
  1580. objinput:=CObjInput.Create;
  1581. if objinput.ReadObjData(objreader,objdata) then
  1582. begin
  1583. stmt:=TStaticLibrary.create_object(objdata);
  1584. stmt.AsNeeded:=asneededflag;
  1585. TFPObjectList(FGroupStack.Last).Add(stmt);
  1586. end;
  1587. objinput.Free;
  1588. objreader.Free;
  1589. end
  1590. else { try parsing as script }
  1591. begin
  1592. Comment(V_Tried,'Interpreting '+para+' as ld script');
  1593. ScriptLexer:=TScriptLexer.Create(objreader);
  1594. ParseLdScript(ScriptLexer);
  1595. ScriptLexer.Free;
  1596. objreader.Free;
  1597. end;
  1598. end;
  1599. procedure TInternalLinker.Load_Group;
  1600. var
  1601. group: TStaticLibrary;
  1602. begin
  1603. group:=TStaticLibrary.create_group;
  1604. TFPObjectList(FGroupStack.Last).Add(group);
  1605. FGroupStack.Add(group.GroupMembers);
  1606. end;
  1607. procedure TInternalLinker.Load_EndGroup;
  1608. begin
  1609. FGroupStack.Delete(FGroupStack.Count-1);
  1610. end;
  1611. procedure TInternalLinker.ParseScript_Handle;
  1612. var
  1613. s{, para}, keyword : String;
  1614. hp : TCmdStrListItem;
  1615. i : longint;
  1616. begin
  1617. hp:=TCmdStrListItem(linkscript.first);
  1618. i:=0;
  1619. while assigned(hp) do
  1620. begin
  1621. inc(i);
  1622. s:=hp.str;
  1623. if (s='') or (s[1]='#') then
  1624. begin
  1625. hp:=TCmdStrListItem(hp.next);
  1626. continue;
  1627. end;
  1628. keyword:=Upper(GetToken(s,' '));
  1629. {para:=}GetToken(s,' ');
  1630. if Trim(s)<>'' then
  1631. Comment(V_Warning,'Unknown part "'+s+'" in "'+hp.str+'" internal linker script');
  1632. if (keyword<>'SYMBOL') and
  1633. (keyword<>'SYMBOLS') and
  1634. (keyword<>'STABS') and
  1635. (keyword<>'PROVIDE') and
  1636. (keyword<>'ZEROS') and
  1637. (keyword<>'BYTE') and
  1638. (keyword<>'WORD') and
  1639. (keyword<>'LONG') and
  1640. (keyword<>'QUAD') and
  1641. (keyword<>'ENTRYNAME') and
  1642. (keyword<>'ISSHAREDLIBRARY') and
  1643. (keyword<>'IMAGEBASE') and
  1644. (keyword<>'READOBJECT') and
  1645. (keyword<>'READSTATICLIBRARY') and
  1646. (keyword<>'EXESECTION') and
  1647. (keyword<>'ENDEXESECTION') and
  1648. (keyword<>'OBJSECTION') and
  1649. (keyword<>'HEADER') and
  1650. (keyword<>'GROUP') and
  1651. (keyword<>'ENDGROUP')
  1652. then
  1653. Comment(V_Warning,'Unknown keyword "'+keyword+'" in "'+hp.str
  1654. +'" internal linker script');
  1655. hp:=TCmdStrListItem(hp.next);
  1656. end;
  1657. ScriptCount:=i;
  1658. if ScriptCount>0 then
  1659. begin
  1660. GetMem(IsHandled,sizeof(boolean)*ScriptCount);
  1661. Fillchar(IsHandled^,sizeof(boolean)*ScriptCount,#0);
  1662. end;
  1663. end;
  1664. procedure TInternalLinker.ParseScript_PostCheck;
  1665. var
  1666. hp : TCmdStrListItem;
  1667. i : longint;
  1668. begin
  1669. hp:=TCmdStrListItem(linkscript.first);
  1670. i:=0;
  1671. while assigned(hp) do
  1672. begin
  1673. inc(i);
  1674. if not IsHandled^[i] then
  1675. begin
  1676. Comment(V_Warning,'"'+hp.str+
  1677. '" internal linker script not handled');
  1678. end;
  1679. hp:=TCmdStrListItem(hp.next);
  1680. end;
  1681. end;
  1682. function TInternalLinker.ParsePara(const para : string) : string;
  1683. var
  1684. res : string;
  1685. begin
  1686. res:=trim(para);
  1687. { Remove enclosing braces }
  1688. if (length(res)>0) and (res[1]='(') and
  1689. (res[length(res)]=')') then
  1690. res:=trim(copy(res,2,length(res)-2));
  1691. result:=res;
  1692. end;
  1693. procedure TInternalLinker.ParseScript_Load;
  1694. var
  1695. s,
  1696. para,
  1697. keyword : String;
  1698. hp : TCmdStrListItem;
  1699. i : longint;
  1700. handled : boolean;
  1701. begin
  1702. exeoutput.Load_Start;
  1703. hp:=TCmdStrListItem(linkscript.first);
  1704. i:=0;
  1705. while assigned(hp) do
  1706. begin
  1707. inc(i);
  1708. s:=hp.str;
  1709. if (s='') or (s[1]='#') then
  1710. begin
  1711. IsHandled^[i]:=true;
  1712. hp:=TCmdStrListItem(hp.next);
  1713. continue;
  1714. end;
  1715. handled:=true;
  1716. keyword:=Upper(GetToken(s,' '));
  1717. para:=ParsePara(GetToken(s,' '));
  1718. if keyword='SYMBOL' then
  1719. ExeOutput.Load_Symbol(para)
  1720. else if keyword='PROVIDE' then
  1721. ExeOutput.Load_ProvideSymbol(para)
  1722. else if keyword='ENTRYNAME' then
  1723. ExeOutput.Load_EntryName(para)
  1724. else if keyword='ISSHAREDLIBRARY' then
  1725. ExeOutput.Load_IsSharedLibrary
  1726. else if keyword='IMAGEBASE' then
  1727. ExeOutput.Load_ImageBase(para)
  1728. else if keyword='READOBJECT' then
  1729. Load_ReadObject(para)
  1730. else if keyword='STABS' then
  1731. UseStabs:=true
  1732. else if keyword='READSTATICLIBRARY' then
  1733. Load_ReadStaticLibrary(para)
  1734. else if keyword='GROUP' then
  1735. Load_Group
  1736. else if keyword='ENDGROUP' then
  1737. Load_EndGroup
  1738. else
  1739. handled:=false;
  1740. if handled then
  1741. IsHandled^[i]:=true;
  1742. hp:=TCmdStrListItem(hp.next);
  1743. end;
  1744. end;
  1745. procedure TInternalLinker.ParseScript_Order;
  1746. var
  1747. s,
  1748. para,
  1749. keyword : String;
  1750. hp : TCmdStrListItem;
  1751. i : longint;
  1752. handled : boolean;
  1753. begin
  1754. exeoutput.Order_Start;
  1755. hp:=TCmdStrListItem(linkscript.first);
  1756. i:=0;
  1757. while assigned(hp) do
  1758. begin
  1759. inc(i);
  1760. s:=hp.str;
  1761. if (s='') or (s[1]='#') then
  1762. begin
  1763. hp:=TCmdStrListItem(hp.next);
  1764. continue;
  1765. end;
  1766. handled:=true;
  1767. keyword:=Upper(GetToken(s,' '));
  1768. para:=ParsePara(GetToken(s,' '));
  1769. if keyword='EXESECTION' then
  1770. ExeOutput.Order_ExeSection(para)
  1771. else if keyword='ENDEXESECTION' then
  1772. ExeOutput.Order_EndExeSection
  1773. else if keyword='OBJSECTION' then
  1774. ExeOutput.Order_ObjSection(para)
  1775. else if keyword='ZEROS' then
  1776. ExeOutput.Order_Zeros(para)
  1777. else if keyword='BYTE' then
  1778. ExeOutput.Order_Values(1,para)
  1779. else if keyword='WORD' then
  1780. ExeOutput.Order_Values(2,para)
  1781. else if keyword='LONG' then
  1782. ExeOutput.Order_Values(4,para)
  1783. else if keyword='QUAD' then
  1784. ExeOutput.Order_Values(8,para)
  1785. else if keyword='SYMBOL' then
  1786. ExeOutput.Order_Symbol(para)
  1787. else if keyword='PROVIDE' then
  1788. ExeOutput.Order_ProvideSymbol(para)
  1789. else
  1790. handled:=false;
  1791. if handled then
  1792. IsHandled^[i]:=true;
  1793. hp:=TCmdStrListItem(hp.next);
  1794. end;
  1795. exeoutput.Order_End;
  1796. end;
  1797. procedure TInternalLinker.ParseScript_MemPos;
  1798. var
  1799. s,
  1800. para,
  1801. keyword : String;
  1802. hp : TCmdStrListItem;
  1803. i : longint;
  1804. handled : boolean;
  1805. begin
  1806. exeoutput.MemPos_Start;
  1807. hp:=TCmdStrListItem(linkscript.first);
  1808. i:=0;
  1809. while assigned(hp) do
  1810. begin
  1811. inc(i);
  1812. s:=hp.str;
  1813. if (s='') or (s[1]='#') then
  1814. begin
  1815. hp:=TCmdStrListItem(hp.next);
  1816. continue;
  1817. end;
  1818. handled:=true;
  1819. keyword:=Upper(GetToken(s,' '));
  1820. para:=ParsePara(GetToken(s,' '));
  1821. if keyword='EXESECTION' then
  1822. ExeOutput.MemPos_ExeSection(para)
  1823. else if keyword='ENDEXESECTION' then
  1824. ExeOutput.MemPos_EndExeSection
  1825. else if keyword='HEADER' then
  1826. ExeOutput.MemPos_Header
  1827. else
  1828. handled:=false;
  1829. if handled then
  1830. IsHandled^[i]:=true;
  1831. hp:=TCmdStrListItem(hp.next);
  1832. end;
  1833. end;
  1834. procedure TInternalLinker.ParseScript_DataPos;
  1835. var
  1836. s,
  1837. para,
  1838. keyword : String;
  1839. hp : TCmdStrListItem;
  1840. i : longint;
  1841. handled : boolean;
  1842. begin
  1843. exeoutput.DataPos_Start;
  1844. hp:=TCmdStrListItem(linkscript.first);
  1845. i:=0;
  1846. while assigned(hp) do
  1847. begin
  1848. inc(i);
  1849. s:=hp.str;
  1850. if (s='') or (s[1]='#') then
  1851. begin
  1852. hp:=TCmdStrListItem(hp.next);
  1853. continue;
  1854. end;
  1855. handled:=true;
  1856. keyword:=Upper(GetToken(s,' '));
  1857. para:=ParsePara(GetToken(s,' '));
  1858. if keyword='EXESECTION' then
  1859. ExeOutput.DataPos_ExeSection(para)
  1860. else if keyword='ENDEXESECTION' then
  1861. ExeOutput.DataPos_EndExeSection
  1862. else if keyword='HEADER' then
  1863. ExeOutput.DataPos_Header
  1864. else if keyword='SYMBOLS' then
  1865. ExeOutput.DataPos_Symbols
  1866. else
  1867. handled:=false;
  1868. if handled then
  1869. IsHandled^[i]:=true;
  1870. hp:=TCmdStrListItem(hp.next);
  1871. end;
  1872. end;
  1873. procedure TInternalLinker.PrintLinkerScript;
  1874. var
  1875. hp : TCmdStrListItem;
  1876. begin
  1877. if not assigned(exemap) then
  1878. exit;
  1879. exemap.Add('Used linker script');
  1880. exemap.Add('');
  1881. hp:=TCmdStrListItem(linkscript.first);
  1882. while assigned(hp) do
  1883. begin
  1884. exemap.Add(hp.str);
  1885. hp:=TCmdStrListItem(hp.next);
  1886. end;
  1887. end;
  1888. function TInternalLinker.RunLinkScript(const outputname:TCmdStr):boolean;
  1889. label
  1890. myexit;
  1891. var
  1892. bsssize : qword;
  1893. dbgname : TCmdStr;
  1894. begin
  1895. result:=false;
  1896. Message1(exec_i_linking,outputname);
  1897. FlushOutput;
  1898. exeoutput:=CExeOutput.Create;
  1899. { TODO: Load custom linker script}
  1900. DefaultLinkScript;
  1901. if (cs_link_map in current_settings.globalswitches) then
  1902. exemap:=texemap.create(current_module.mapfilename);
  1903. PrintLinkerScript;
  1904. { Check that syntax is OK }
  1905. ParseScript_Handle;
  1906. { Load .o files and resolve symbols }
  1907. FGroupStack.Add(FStaticLibraryList);
  1908. ParseScript_Load;
  1909. if ErrorCount>0 then
  1910. goto myexit;
  1911. exeoutput.ResolveSymbols(StaticLibraryList);
  1912. { Generate symbols and code to do the importing }
  1913. exeoutput.GenerateLibraryImports(ImportLibraryList);
  1914. { Fill external symbols data }
  1915. exeoutput.FixupSymbols;
  1916. if ErrorCount>0 then
  1917. goto myexit;
  1918. { parse linker options specific for output format }
  1919. exeoutput.ParseScript (linkscript);
  1920. { Create .exe sections and add .o sections }
  1921. ParseScript_Order;
  1922. exeoutput.RemoveUnreferencedSections;
  1923. { if UseStabs then, this would remove
  1924. STABS for empty linker scripts }
  1925. exeoutput.MergeStabs;
  1926. exeoutput.MarkEmptySections;
  1927. exeoutput.AfterUnusedSectionRemoval;
  1928. if ErrorCount>0 then
  1929. goto myexit;
  1930. { Calc positions in mem }
  1931. ParseScript_MemPos;
  1932. exeoutput.FixupRelocations;
  1933. exeoutput.RemoveUnusedExeSymbols;
  1934. exeoutput.PrintMemoryMap;
  1935. if ErrorCount>0 then
  1936. goto myexit;
  1937. if cs_link_separate_dbg_file in current_settings.globalswitches then
  1938. begin
  1939. { create debuginfo, which is an executable without data on disk }
  1940. dbgname:=ChangeFileExt(outputname,'.dbg');
  1941. exeoutput.ExeWriteMode:=ewm_dbgonly;
  1942. ParseScript_DataPos;
  1943. exeoutput.WriteExeFile(dbgname);
  1944. { create executable with link to just created debuginfo file }
  1945. exeoutput.ExeWriteMode:=ewm_exeonly;
  1946. exeoutput.RemoveDebugInfo;
  1947. exeoutput.GenerateDebugLink(ExtractFileName(dbgname),GetFileCRC(dbgname));
  1948. ParseScript_MemPos;
  1949. ParseScript_DataPos;
  1950. exeoutput.WriteExeFile(outputname);
  1951. end
  1952. else
  1953. begin
  1954. exeoutput.ExeWriteMode:=ewm_exefull;
  1955. ParseScript_DataPos;
  1956. exeoutput.WriteExeFile(outputname);
  1957. end;
  1958. { Post check that everything was handled }
  1959. ParseScript_PostCheck;
  1960. status.codesize:=GetCodeSize(exeoutput);
  1961. status.datasize:=GetDataSize(exeoutput);
  1962. bsssize:=GetBssSize(exeoutput);
  1963. { Executable info }
  1964. Message1(execinfo_x_codesize,tostr(status.codesize));
  1965. Message1(execinfo_x_initdatasize,tostr(status.datasize));
  1966. Message1(execinfo_x_uninitdatasize,tostr(bsssize));
  1967. Message1(execinfo_x_stackreserve,tostr(stacksize));
  1968. myexit:
  1969. { close map }
  1970. if assigned(exemap) then
  1971. begin
  1972. exemap.free;
  1973. exemap:=nil;
  1974. end;
  1975. { close exe }
  1976. exeoutput.free;
  1977. exeoutput:=nil;
  1978. result:=true;
  1979. end;
  1980. function TInternalLinker.ExecutableFilename:String;
  1981. begin
  1982. result:=current_module.exefilename;
  1983. end;
  1984. function TInternalLinker.SharedLibFilename:String;
  1985. begin
  1986. result:=current_module.sharedlibfilename;
  1987. end;
  1988. function TInternalLinker.MakeExecutable:boolean;
  1989. begin
  1990. IsSharedLibrary:=false;
  1991. result:=RunLinkScript(ExecutableFilename);
  1992. {$ifdef hasUnix}
  1993. fpchmod(current_module.exefilename,493);
  1994. {$endif hasUnix}
  1995. end;
  1996. function TInternalLinker.MakeSharedLibrary:boolean;
  1997. begin
  1998. IsSharedLibrary:=true;
  1999. result:=RunLinkScript(SharedLibFilename);
  2000. end;
  2001. procedure TInternalLinker.ScriptAddGenericSections(secnames:string);
  2002. var
  2003. secname:string;
  2004. begin
  2005. repeat
  2006. secname:=gettoken(secnames,',');
  2007. if secname='' then
  2008. break;
  2009. linkscript.Concat('EXESECTION '+secname);
  2010. linkscript.Concat(' OBJSECTION '+secname+'*');
  2011. linkscript.Concat('ENDEXESECTION');
  2012. until false;
  2013. end;
  2014. {*****************************************************************************
  2015. Init/Done
  2016. *****************************************************************************}
  2017. procedure RegisterLinker(id:tlink;c:TLinkerClass);
  2018. begin
  2019. CLinker[id]:=c;
  2020. end;
  2021. procedure InitLinker;
  2022. begin
  2023. if (cs_link_extern in current_settings.globalswitches) and
  2024. assigned(CLinker[target_info.linkextern]) then
  2025. begin
  2026. linker:=CLinker[target_info.linkextern].Create;
  2027. end
  2028. else
  2029. if assigned(CLinker[target_info.link]) then
  2030. begin
  2031. linker:=CLinker[target_info.link].Create;
  2032. end
  2033. else
  2034. linker:=Tlinker.Create;
  2035. end;
  2036. procedure DoneLinker;
  2037. begin
  2038. if assigned(linker) then
  2039. Linker.Free;
  2040. end;
  2041. {*****************************************************************************
  2042. Initialize
  2043. *****************************************************************************}
  2044. const
  2045. ar_gnu_ar_info : tarinfo =
  2046. (
  2047. id : ar_gnu_ar;
  2048. addfilecmd : '';
  2049. arfirstcmd : '';
  2050. arcmd : 'ar qS $LIB $FILES';
  2051. arfinishcmd : 'ar s $LIB'
  2052. );
  2053. ar_gnu_ar_scripted_info : tarinfo =
  2054. (
  2055. id : ar_gnu_ar_scripted;
  2056. addfilecmd : '';
  2057. arfirstcmd : '';
  2058. arcmd : 'ar -M < $SCRIPT';
  2059. arfinishcmd : ''
  2060. );
  2061. ar_gnu_gar_info : tarinfo =
  2062. ( id : ar_gnu_gar;
  2063. addfilecmd : '';
  2064. arfirstcmd : '';
  2065. arcmd : 'gar qS $LIB $FILES';
  2066. arfinishcmd : 'gar s $LIB'
  2067. );
  2068. ar_watcom_wlib_omf_info : tarinfo =
  2069. ( id : ar_watcom_wlib_omf;
  2070. addfilecmd : '+';
  2071. arfirstcmd : 'wlib -q $RECSIZE -fo -c -b -n -o=$OUTPUTLIB $LIB $FILES';
  2072. arcmd : 'wlib -q $RECSIZE -fo -c -b -o=$OUTPUTLIB $LIB $FILES';
  2073. arfinishcmd : ''
  2074. );
  2075. ar_watcom_wlib_omf_scripted_info : tarinfo =
  2076. (
  2077. id : ar_watcom_wlib_omf_scripted;
  2078. addfilecmd : '+';
  2079. arfirstcmd : '';
  2080. arcmd : 'wlib @$SCRIPT';
  2081. arfinishcmd : ''
  2082. );
  2083. ar_sdcc_sdar_info : tarinfo =
  2084. ( id : ar_sdcc_sdar;
  2085. addfilecmd : '';
  2086. arfirstcmd : '';
  2087. arcmd : 'sdar qS $LIB $FILES';
  2088. arfinishcmd : 'sdar s $LIB'
  2089. );
  2090. ar_sdcc_sdar_scripted_info : tarinfo =
  2091. (
  2092. id : ar_sdcc_sdar_scripted;
  2093. addfilecmd : '';
  2094. arfirstcmd : '';
  2095. arcmd : 'sdar -M < $SCRIPT';
  2096. arfinishcmd : ''
  2097. );
  2098. initialization
  2099. RegisterAr(ar_gnu_ar_info);
  2100. RegisterAr(ar_gnu_ar_scripted_info);
  2101. RegisterAr(ar_gnu_gar_info);
  2102. RegisterAr(ar_watcom_wlib_omf_info);
  2103. RegisterAr(ar_watcom_wlib_omf_scripted_info);
  2104. RegisterAr(ar_sdcc_sdar_info);
  2105. RegisterAr(ar_sdcc_sdar_scripted_info);
  2106. end.