link.pas 78 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296
  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):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):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 (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. Message(exec_e_cant_call_linker);
  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. function GetNextFiles(const maxCmdLength : Longint; var item : TCmdStrListItem; const addfilecmd : string) : TCmdStr;
  835. begin
  836. result := '';
  837. while (assigned(item) and ((length(result) + length(item.str) + 1) < maxCmdLength)) do begin
  838. result := result + ' ' + addfilecmd + item.str;
  839. item := TCmdStrListItem(item.next);
  840. end;
  841. end;
  842. function get_wlib_record_size: integer;
  843. begin
  844. result:=align(align(SmartLinkOFiles.Count,128) div 128,16);
  845. end;
  846. var
  847. binstr, firstbinstr, scriptfile : TCmdStr;
  848. cmdstr, firstcmd, nextcmd, smartpath : TCmdStr;
  849. current : TCmdStrListItem;
  850. script: Text;
  851. scripted_ar : boolean;
  852. ar_creates_different_output_file : boolean;
  853. success : boolean;
  854. first : boolean;
  855. begin
  856. MakeStaticLibrary:=false;
  857. { remove the library, to be sure that it is rewritten }
  858. DeleteFile(current_module.staticlibfilename);
  859. { Call AR }
  860. smartpath:=FixPath(ChangeFileExt(current_module.asmfilename,target_info.smartext),false);
  861. SplitBinCmd(target_ar.arcmd,binstr,cmdstr);
  862. binstr := FindUtil(utilsprefix + binstr);
  863. if target_ar.arfirstcmd<>'' then
  864. begin
  865. SplitBinCmd(target_ar.arfirstcmd,firstbinstr,firstcmd);
  866. firstbinstr := FindUtil(utilsprefix + firstbinstr);
  867. end
  868. else
  869. begin
  870. firstbinstr:=binstr;
  871. firstcmd:=cmdstr;
  872. end;
  873. scripted_ar:=(target_ar.id=ar_gnu_ar_scripted) or
  874. (target_ar.id=ar_watcom_wlib_omf_scripted) or
  875. (target_ar.id=ar_sdcc_sdar_scripted);
  876. if scripted_ar then
  877. begin
  878. scriptfile := FixFileName(smartpath+'arscript.txt');
  879. Replace(cmdstr,'$SCRIPT',maybequoted(scriptfile));
  880. Assign(script, scriptfile);
  881. Rewrite(script);
  882. try
  883. if (target_ar.id in [ar_gnu_ar_scripted,ar_sdcc_sdar_scripted]) then
  884. writeln(script, 'CREATE ' + current_module.staticlibfilename)
  885. else { wlib case }
  886. writeln(script,'-q -p=',get_wlib_record_size,' -fo -c -b '+
  887. maybequoted(current_module.staticlibfilename));
  888. current := TCmdStrListItem(SmartLinkOFiles.First);
  889. while current <> nil do
  890. begin
  891. if (target_ar.id in [ar_gnu_ar_scripted,ar_sdcc_sdar_scripted]) then
  892. writeln(script, 'ADDMOD ' + current.str)
  893. else
  894. writeln(script,'+' + current.str);
  895. current := TCmdStrListItem(current.next);
  896. end;
  897. if (target_ar.id in [ar_gnu_ar_scripted,ar_sdcc_sdar_scripted]) then
  898. begin
  899. writeln(script, 'SAVE');
  900. writeln(script, 'END');
  901. end;
  902. finally
  903. Close(script);
  904. end;
  905. success:=DoExec(binstr,cmdstr,false,true);
  906. end
  907. else
  908. begin
  909. ar_creates_different_output_file:=(Pos('$OUTPUTLIB',cmdstr)>0) or (Pos('$OUTPUTLIB',firstcmd)>0);
  910. Replace(cmdstr,'$LIB',maybequoted(current_module.staticlibfilename));
  911. Replace(firstcmd,'$LIB',maybequoted(current_module.staticlibfilename));
  912. Replace(cmdstr,'$OUTPUTLIB',maybequoted(current_module.staticlibfilename+'.tmp'));
  913. Replace(firstcmd,'$OUTPUTLIB',maybequoted(current_module.staticlibfilename+'.tmp'));
  914. if target_ar.id=ar_watcom_wlib_omf then
  915. begin
  916. Replace(cmdstr,'$RECSIZE','-p='+IntToStr(get_wlib_record_size));
  917. Replace(firstcmd,'$RECSIZE','-p='+IntToStr(get_wlib_record_size));
  918. end;
  919. { create AR commands }
  920. success := true;
  921. current := TCmdStrListItem(SmartLinkOFiles.First);
  922. first := true;
  923. repeat
  924. if first then
  925. nextcmd := firstcmd
  926. else
  927. nextcmd := cmdstr;
  928. Replace(nextcmd,'$FILES',GetNextFiles(2047, current, target_ar.addfilecmd));
  929. if first then
  930. success:=DoExec(firstbinstr,nextcmd,false,true)
  931. else
  932. success:=DoExec(binstr,nextcmd,false,true);
  933. if ar_creates_different_output_file then
  934. begin
  935. if FileExists(current_module.staticlibfilename,false) then
  936. DeleteFile(current_module.staticlibfilename);
  937. if FileExists(current_module.staticlibfilename+'.tmp',false) then
  938. RenameFile(current_module.staticlibfilename+'.tmp',current_module.staticlibfilename);
  939. end;
  940. first := false;
  941. until (not assigned(current)) or (not success);
  942. end;
  943. if (target_ar.arfinishcmd <> '') then
  944. begin
  945. SplitBinCmd(target_ar.arfinishcmd,binstr,cmdstr);
  946. binstr := FindUtil(utilsprefix + binstr);
  947. Replace(cmdstr,'$LIB',maybequoted(current_module.staticlibfilename));
  948. success:=DoExec(binstr,cmdstr,false,true);
  949. end;
  950. { Clean up }
  951. if not(cs_asm_leave in current_settings.globalswitches) then
  952. if not(cs_link_nolink in current_settings.globalswitches) then
  953. begin
  954. while not SmartLinkOFiles.Empty do
  955. DeleteFile(SmartLinkOFiles.GetFirst);
  956. if scripted_ar then
  957. DeleteFile(scriptfile);
  958. RemoveDir(smartpath);
  959. end
  960. else
  961. begin
  962. while not SmartLinkOFiles.Empty do
  963. AsmRes.AddDeleteCommand(SmartLinkOFiles.GetFirst);
  964. if scripted_ar then
  965. AsmRes.AddDeleteCommand(scriptfile);
  966. AsmRes.AddDeleteDirCommand(smartpath);
  967. end;
  968. MakeStaticLibrary:=success;
  969. end;
  970. function TExternalLinker.UniqueName(const str: TCmdStr): TCmdStr;
  971. const
  972. pid: SizeUInt = 0;
  973. begin
  974. if pid=0 then
  975. pid:=GetProcessID;
  976. if pid>0 then
  977. result:=str+tostr(pid)
  978. else
  979. result:=str;
  980. end;
  981. function TExternalLinker.PostProcessELFExecutable(const fn : string;isdll:boolean):boolean;
  982. type
  983. TElf32header=packed record
  984. magic0123 : array[0..3] of char;
  985. file_class : byte;
  986. data_encoding : byte;
  987. file_version : byte;
  988. padding : array[$07..$0f] of byte;
  989. e_type : word;
  990. e_machine : word;
  991. e_version : longint;
  992. e_entry : longint; { entrypoint }
  993. e_phoff : longint; { program header offset }
  994. e_shoff : longint; { sections header offset }
  995. e_flags : longint;
  996. e_ehsize : word; { elf header size in bytes }
  997. e_phentsize : word; { size of an entry in the program header array }
  998. e_phnum : word; { 0..e_phnum-1 of entrys }
  999. e_shentsize : word; { size of an entry in sections header array }
  1000. e_shnum : word; { 0..e_shnum-1 of entrys }
  1001. e_shstrndx : word; { index of string section header }
  1002. end;
  1003. TElf32sechdr=packed record
  1004. sh_name : longint;
  1005. sh_type : longint;
  1006. sh_flags : longint;
  1007. sh_addr : longint;
  1008. sh_offset : longint;
  1009. sh_size : longint;
  1010. sh_link : longint;
  1011. sh_info : longint;
  1012. sh_addralign : longint;
  1013. sh_entsize : longint;
  1014. end;
  1015. telf64header=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 : longword;
  1024. e_entry : qword; { entrypoint }
  1025. e_phoff : qword; { program header offset }
  1026. e_shoff : qword; { sections header offset }
  1027. e_flags : longword;
  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. TElf64sechdr=packed record
  1036. sh_name : longword;
  1037. sh_type : longword;
  1038. sh_flags : qword;
  1039. sh_addr : qword;
  1040. sh_offset : qword;
  1041. sh_size : qword;
  1042. sh_link : longword;
  1043. sh_info : longword;
  1044. sh_addralign : qword;
  1045. sh_entsize : qword;
  1046. end;
  1047. function MayBeSwapHeader(h : telf32header) : telf32header;
  1048. begin
  1049. result:=h;
  1050. if source_info.endian<>target_info.endian then
  1051. with h do
  1052. begin
  1053. result.e_type:=swapendian(e_type);
  1054. result.e_machine:=swapendian(e_machine);
  1055. result.e_version:=swapendian(e_version);
  1056. result.e_entry:=swapendian(e_entry);
  1057. result.e_phoff:=swapendian(e_phoff);
  1058. result.e_shoff:=swapendian(e_shoff);
  1059. result.e_flags:=swapendian(e_flags);
  1060. result.e_ehsize:=swapendian(e_ehsize);
  1061. result.e_phentsize:=swapendian(e_phentsize);
  1062. result.e_phnum:=swapendian(e_phnum);
  1063. result.e_shentsize:=swapendian(e_shentsize);
  1064. result.e_shnum:=swapendian(e_shnum);
  1065. result.e_shstrndx:=swapendian(e_shstrndx);
  1066. end;
  1067. end;
  1068. function MayBeSwapHeader(h : telf64header) : telf64header;
  1069. begin
  1070. result:=h;
  1071. if source_info.endian<>target_info.endian then
  1072. with h do
  1073. begin
  1074. result.e_type:=swapendian(e_type);
  1075. result.e_machine:=swapendian(e_machine);
  1076. result.e_version:=swapendian(e_version);
  1077. result.e_entry:=swapendian(e_entry);
  1078. result.e_phoff:=swapendian(e_phoff);
  1079. result.e_shoff:=swapendian(e_shoff);
  1080. result.e_flags:=swapendian(e_flags);
  1081. result.e_ehsize:=swapendian(e_ehsize);
  1082. result.e_phentsize:=swapendian(e_phentsize);
  1083. result.e_phnum:=swapendian(e_phnum);
  1084. result.e_shentsize:=swapendian(e_shentsize);
  1085. result.e_shnum:=swapendian(e_shnum);
  1086. result.e_shstrndx:=swapendian(e_shstrndx);
  1087. end;
  1088. end;
  1089. function MaybeSwapSecHeader(h : telf32sechdr) : telf32sechdr;
  1090. begin
  1091. result:=h;
  1092. if source_info.endian<>target_info.endian then
  1093. with h do
  1094. begin
  1095. result.sh_name:=swapendian(sh_name);
  1096. result.sh_type:=swapendian(sh_type);
  1097. result.sh_flags:=swapendian(sh_flags);
  1098. result.sh_addr:=swapendian(sh_addr);
  1099. result.sh_offset:=swapendian(sh_offset);
  1100. result.sh_size:=swapendian(sh_size);
  1101. result.sh_link:=swapendian(sh_link);
  1102. result.sh_info:=swapendian(sh_info);
  1103. result.sh_addralign:=swapendian(sh_addralign);
  1104. result.sh_entsize:=swapendian(sh_entsize);
  1105. end;
  1106. end;
  1107. function MaybeSwapSecHeader(h : telf64sechdr) : telf64sechdr;
  1108. begin
  1109. result:=h;
  1110. if source_info.endian<>target_info.endian then
  1111. with h do
  1112. begin
  1113. result.sh_name:=swapendian(sh_name);
  1114. result.sh_type:=swapendian(sh_type);
  1115. result.sh_flags:=swapendian(sh_flags);
  1116. result.sh_addr:=swapendian(sh_addr);
  1117. result.sh_offset:=swapendian(sh_offset);
  1118. result.sh_size:=swapendian(sh_size);
  1119. result.sh_link:=swapendian(sh_link);
  1120. result.sh_info:=swapendian(sh_info);
  1121. result.sh_addralign:=swapendian(sh_addralign);
  1122. result.sh_entsize:=swapendian(sh_entsize);
  1123. end;
  1124. end;
  1125. var
  1126. f : file;
  1127. function ReadSectionName(pos : longint) : String;
  1128. var
  1129. oldpos : longint;
  1130. c : char;
  1131. begin
  1132. oldpos:=filepos(f);
  1133. seek(f,pos);
  1134. Result:='';
  1135. while true do
  1136. begin
  1137. blockread(f,c,1);
  1138. if c=#0 then
  1139. break;
  1140. Result:=Result+c;
  1141. end;
  1142. seek(f,oldpos);
  1143. end;
  1144. var
  1145. elfheader32 : TElf32header;
  1146. secheader32 : TElf32sechdr;
  1147. elfheader64 : TElf64header;
  1148. secheader64 : TElf64sechdr;
  1149. i : longint;
  1150. stringoffset : longint;
  1151. secname : string;
  1152. begin
  1153. Result:=false;
  1154. { open file }
  1155. assign(f,fn);
  1156. {$push}{$I-}
  1157. reset(f,1);
  1158. if ioresult<>0 then
  1159. Message1(execinfo_f_cant_open_executable,fn);
  1160. { read header }
  1161. blockread(f,elfheader32,sizeof(tElf32header));
  1162. with elfheader32 do
  1163. if not((magic0123[0]=#$7f) and (magic0123[1]='E') and (magic0123[2]='L') and (magic0123[3]='F')) then
  1164. Exit;
  1165. case elfheader32.file_class of
  1166. 1:
  1167. begin
  1168. elfheader32:=MayBeSwapHeader(elfheader32);
  1169. seek(f,elfheader32.e_shoff);
  1170. { read string section header }
  1171. seek(f,elfheader32.e_shoff+sizeof(TElf32sechdr)*elfheader32.e_shstrndx);
  1172. blockread(f,secheader32,sizeof(secheader32));
  1173. secheader32:=MaybeSwapSecHeader(secheader32);
  1174. stringoffset:=secheader32.sh_offset;
  1175. seek(f,elfheader32.e_shoff);
  1176. status.datasize:=0;
  1177. for i:=0 to elfheader32.e_shnum-1 do
  1178. begin
  1179. blockread(f,secheader32,sizeof(secheader32));
  1180. secheader32:=MaybeSwapSecHeader(secheader32);
  1181. secname:=ReadSectionName(stringoffset+secheader32.sh_name);
  1182. case secname of
  1183. '.text':
  1184. begin
  1185. Message1(execinfo_x_codesize,tostr(secheader32.sh_size));
  1186. status.codesize:=secheader32.sh_size;
  1187. end;
  1188. '.fpcdata',
  1189. '.rodata',
  1190. '.data':
  1191. begin
  1192. Message1(execinfo_x_initdatasize,tostr(secheader32.sh_size));
  1193. inc(status.datasize,secheader32.sh_size);
  1194. end;
  1195. '.bss':
  1196. begin
  1197. Message1(execinfo_x_uninitdatasize,tostr(secheader32.sh_size));
  1198. inc(status.datasize,secheader32.sh_size);
  1199. end;
  1200. end;
  1201. end;
  1202. end;
  1203. 2:
  1204. begin
  1205. seek(f,0);
  1206. blockread(f,elfheader64,sizeof(tElf64header));
  1207. with elfheader64 do
  1208. if not((magic0123[0]=#$7f) and (magic0123[1]='E') and (magic0123[2]='L') and (magic0123[3]='F')) then
  1209. Exit;
  1210. elfheader64:=MayBeSwapHeader(elfheader64);
  1211. seek(f,elfheader64.e_shoff);
  1212. { read string section header }
  1213. seek(f,elfheader64.e_shoff+sizeof(TElf64sechdr)*elfheader64.e_shstrndx);
  1214. blockread(f,secheader64,sizeof(secheader64));
  1215. secheader64:=MaybeSwapSecHeader(secheader64);
  1216. stringoffset:=secheader64.sh_offset;
  1217. seek(f,elfheader64.e_shoff);
  1218. status.datasize:=0;
  1219. for i:=0 to elfheader64.e_shnum-1 do
  1220. begin
  1221. blockread(f,secheader64,sizeof(secheader64));
  1222. secheader64:=MaybeSwapSecHeader(secheader64);
  1223. secname:=ReadSectionName(stringoffset+secheader64.sh_name);
  1224. case secname of
  1225. '.text':
  1226. begin
  1227. Message1(execinfo_x_codesize,tostr(secheader64.sh_size));
  1228. status.codesize:=secheader64.sh_size;
  1229. end;
  1230. '.fpcdata',
  1231. '.rodata',
  1232. '.data':
  1233. begin
  1234. Message1(execinfo_x_initdatasize,tostr(secheader64.sh_size));
  1235. inc(status.datasize,secheader64.sh_size);
  1236. end;
  1237. '.bss':
  1238. begin
  1239. Message1(execinfo_x_uninitdatasize,tostr(secheader64.sh_size));
  1240. inc(status.datasize,secheader64.sh_size);
  1241. end;
  1242. end;
  1243. end;
  1244. end;
  1245. else
  1246. exit;
  1247. end;
  1248. close(f);
  1249. {$pop}
  1250. if ioresult<>0 then
  1251. ;
  1252. Result:=true;
  1253. end;
  1254. function TExternalLinker.PostProcessMachExecutable(const fn : string;isdll:boolean):boolean;
  1255. type
  1256. TMachHeader=record
  1257. magic : longword;
  1258. cputype : integer;
  1259. cpusubtype : integer;
  1260. filetype : longword;
  1261. ncmds : longword;
  1262. sizeofcmds : longword;
  1263. flags : longword;
  1264. reserved : longword;
  1265. end;
  1266. TMachLoadCommand = record
  1267. cmd : longword;
  1268. cmdsize : longword;
  1269. end;
  1270. TMachSegmentCommand64 = record
  1271. segname : array[0..15] of char;
  1272. vmaddr : qword;
  1273. vmsize : qword;
  1274. fileoff : qword;
  1275. filesize : qword;
  1276. maxprot : integer;
  1277. initprot : integer;
  1278. nsects : dword;
  1279. flags : dword;
  1280. end;
  1281. var
  1282. f : file;
  1283. machheader : TMachHeader;
  1284. machloadcmd : TMachLoadCommand;
  1285. machsegmentcommand64 :TMachSegmentCommand64;
  1286. i : longint;
  1287. begin
  1288. Result:=false;
  1289. { open file }
  1290. assign(f,fn);
  1291. {$push}{$I-}
  1292. reset(f,1);
  1293. if ioresult<>0 then
  1294. Message1(execinfo_f_cant_open_executable,fn);
  1295. {$ifdef DEBUG_MACHO_INFO}
  1296. writeln('Start reading Mach-O file');
  1297. {$endif DEBUG_MACHO_INFO}
  1298. blockread(f,machheader,sizeof(TMachHeader));
  1299. if machheader.magic<>$feedfacf then
  1300. Exit;
  1301. {$ifdef DEBUG_MACHO_INFO}
  1302. writeln('Magic header recognized (64 Bit, Little Endian)');
  1303. writeln('Reading ',machheader.ncmds,' commands');
  1304. {$endif DEBUG_MACHO_INFO}
  1305. for i:=1 to machheader.ncmds do
  1306. begin
  1307. blockread(f,machloadcmd,sizeof(machloadcmd));
  1308. case machloadcmd.cmd of
  1309. $19:
  1310. begin
  1311. blockread(f,machsegmentcommand64,sizeof(machsegmentcommand64));
  1312. {$ifdef DEBUG_MACHO_INFO}
  1313. writeln('Found SegmentCommand64: Name = ',StrPas(@machsegmentcommand64.segname),
  1314. '; VMSize = $',hexstr(machsegmentcommand64.vmsize,8),
  1315. '; FileSize = $',hexstr(machsegmentcommand64.filesize,8));
  1316. {$endif DEBUG_MACHO_INFO}
  1317. case StrPas(@machsegmentcommand64.segname) of
  1318. '__TEXT':
  1319. begin
  1320. Message1(execinfo_x_codesize,tostr(machsegmentcommand64.vmsize));
  1321. status.codesize:=machsegmentcommand64.vmsize;
  1322. end;
  1323. '__DATA_CONST':
  1324. begin
  1325. Message1(execinfo_x_initdatasize,tostr(machsegmentcommand64.vmsize));
  1326. inc(status.datasize,machsegmentcommand64.vmsize);
  1327. end;
  1328. '__DATA':
  1329. begin
  1330. Message1(execinfo_x_uninitdatasize,tostr(machsegmentcommand64.vmsize));
  1331. inc(status.datasize,machsegmentcommand64.vmsize);
  1332. end;
  1333. end;
  1334. Seek(f,FilePos(f)+machloadcmd.cmdsize-sizeof(machloadcmd)-sizeof(machsegmentcommand64));
  1335. end;
  1336. else
  1337. begin
  1338. {$ifdef DEBUG_MACHO_INFO}
  1339. writeln('Found Load Command: $',hexstr(machloadcmd.cmd,4),', skipping');
  1340. {$endif DEBUG_MACHO_INFO}
  1341. Seek(f,FilePos(f)+machloadcmd.cmdsize-sizeof(machloadcmd));
  1342. end;
  1343. end;
  1344. end;
  1345. close(f);
  1346. {$pop}
  1347. if ioresult<>0 then
  1348. ;
  1349. Result:=true;
  1350. end;
  1351. {*****************************************************************************
  1352. TINTERNALLINKER
  1353. *****************************************************************************}
  1354. Constructor TInternalLinker.Create;
  1355. begin
  1356. inherited Create;
  1357. linkscript:=TCmdStrList.Create;
  1358. FStaticLibraryList:=TFPObjectList.Create(true);
  1359. FImportLibraryList:=TFPHashObjectList.Create(true);
  1360. FGroupStack:=TFPObjectList.Create(false);
  1361. exemap:=nil;
  1362. exeoutput:=nil;
  1363. UseStabs:=false;
  1364. CObjInput:=TObjInput;
  1365. ScriptCount:=0;
  1366. IsHandled:=nil;
  1367. end;
  1368. Destructor TInternalLinker.Destroy;
  1369. begin
  1370. FGroupStack.Free;
  1371. linkscript.free;
  1372. StaticLibraryList.Free;
  1373. ImportLibraryList.Free;
  1374. if assigned(IsHandled) then
  1375. begin
  1376. FreeMem(IsHandled,sizeof(boolean)*ScriptCount);
  1377. IsHandled:=nil;
  1378. ScriptCount:=0;
  1379. end;
  1380. if assigned(exeoutput) then
  1381. begin
  1382. exeoutput.free;
  1383. exeoutput:=nil;
  1384. end;
  1385. if assigned(exemap) then
  1386. begin
  1387. exemap.free;
  1388. exemap:=nil;
  1389. end;
  1390. inherited destroy;
  1391. end;
  1392. procedure TInternalLinker.AddImportSymbol(const libname,symname,symmangledname:TCmdStr;OrdNr: longint;isvar:boolean);
  1393. var
  1394. ImportLibrary : TImportLibrary;
  1395. ImportSymbol : TFPHashObject;
  1396. begin
  1397. ImportLibrary:=TImportLibrary(ImportLibraryList.Find(libname));
  1398. if not assigned(ImportLibrary) then
  1399. ImportLibrary:=TImportLibrary.Create(ImportLibraryList,libname);
  1400. ImportSymbol:=TFPHashObject(ImportLibrary.ImportSymbolList.Find(symname));
  1401. if not assigned(ImportSymbol) then
  1402. ImportSymbol:=TImportSymbol.Create(ImportLibrary.ImportSymbolList,symname,symmangledname,OrdNr,isvar);
  1403. end;
  1404. procedure TInternalLinker.ScriptAddSourceStatements(AddSharedAsStatic:boolean);
  1405. var
  1406. s,s2: TCmdStr;
  1407. begin
  1408. while not ObjectFiles.Empty do
  1409. begin
  1410. s:=ObjectFiles.GetFirst;
  1411. if s<>'' then
  1412. LinkScript.Concat('READOBJECT '+MaybeQuoted(s));
  1413. end;
  1414. while not StaticLibFiles.Empty do
  1415. begin
  1416. s:=StaticLibFiles.GetFirst;
  1417. if s<>'' then
  1418. LinkScript.Concat('READSTATICLIBRARY '+MaybeQuoted(s));
  1419. end;
  1420. if not AddSharedAsStatic then
  1421. exit;
  1422. while not SharedLibFiles.Empty do
  1423. begin
  1424. S:=SharedLibFiles.GetFirst;
  1425. if FindLibraryFile(s,target_info.staticClibprefix,target_info.staticClibext,s2) then
  1426. LinkScript.Concat('READSTATICLIBRARY '+MaybeQuoted(s2))
  1427. else
  1428. Comment(V_Error,'Import library not found for '+S);
  1429. end;
  1430. end;
  1431. function TInternalLinker.GetCodeSize(aExeOutput: TExeOutput): QWord;
  1432. begin
  1433. Result:=aExeOutput.findexesection('.text').size;
  1434. end;
  1435. function TInternalLinker.GetDataSize(aExeOutput: TExeOutput): QWord;
  1436. begin
  1437. Result:=aExeOutput.findexesection('.data').size;
  1438. end;
  1439. function TInternalLinker.GetBssSize(aExeOutput: TExeOutput): QWord;
  1440. var
  1441. bsssec: TExeSection;
  1442. begin
  1443. bsssec:=aExeOutput.findexesection('.bss');
  1444. if assigned(bsssec) then
  1445. Result:=bsssec.size
  1446. else
  1447. Result:=0;
  1448. end;
  1449. procedure TInternalLinker.ParseLdScript(src:TScriptLexer);
  1450. var
  1451. asneeded: boolean;
  1452. group: TStaticLibrary;
  1453. procedure ParseInputList;
  1454. var
  1455. saved_asneeded: boolean;
  1456. begin
  1457. src.Expect('(');
  1458. repeat
  1459. if src.CheckForIdent('AS_NEEDED') then
  1460. begin
  1461. saved_asneeded:=asneeded;
  1462. asneeded:=true;
  1463. ParseInputList;
  1464. asneeded:=saved_asneeded;
  1465. end
  1466. else if src.token in [tkIDENT,tkLITERAL] then
  1467. begin
  1468. Load_ReadStaticLibrary(src.tokenstr,asneeded);
  1469. src.nextToken;
  1470. end
  1471. else if src.CheckFor('-') then
  1472. begin
  1473. { TODO: no whitespace between '-' and name;
  1474. name must begin with 'l' }
  1475. src.nextToken;
  1476. end
  1477. else { syntax error, no input_list_element term }
  1478. Break;
  1479. if src.CheckFor(',') then
  1480. Continue;
  1481. until src.CheckFor(')');
  1482. end;
  1483. begin
  1484. asneeded:=false;
  1485. src.nextToken;
  1486. repeat
  1487. if src.CheckForIdent('OUTPUT_FORMAT') then
  1488. begin
  1489. src.Expect('(');
  1490. //writeln('output_format(',src.tokenstr,')');
  1491. src.nextToken;
  1492. src.Expect(')');
  1493. end
  1494. else if src.CheckForIdent('GROUP') then
  1495. begin
  1496. group:=TStaticLibrary.create_group;
  1497. TFPObjectList(FGroupStack.Last).Add(group);
  1498. FGroupStack.Add(group.GroupMembers);
  1499. ParseInputList;
  1500. FGroupStack.Delete(FGroupStack.Count-1);
  1501. end
  1502. else if src.CheckFor(';') then
  1503. {skip semicolon};
  1504. until src.token in [tkEOF,tkINVALID];
  1505. end;
  1506. procedure TInternalLinker.Load_ReadObject(const para:TCmdStr);
  1507. var
  1508. objdata : TObjData;
  1509. objinput : TObjinput;
  1510. objreader : TObjectReader;
  1511. fn : TCmdStr;
  1512. begin
  1513. fn:=FindObjectFile(para,'',false);
  1514. Comment(V_Tried,'Reading object '+fn);
  1515. objinput:=CObjInput.Create;
  1516. objreader:=TObjectreader.create;
  1517. if objreader.openfile(fn) then
  1518. begin
  1519. if objinput.ReadObjData(objreader,objdata) then
  1520. exeoutput.addobjdata(objdata);
  1521. end;
  1522. { release input object }
  1523. objinput.free;
  1524. objreader.free;
  1525. end;
  1526. procedure TInternalLinker.Load_ReadStaticLibrary(const para:TCmdStr;asneededflag:boolean);
  1527. var
  1528. objreader : TObjectReader;
  1529. objinput: TObjInput;
  1530. objdata: TObjData;
  1531. ScriptLexer: TScriptLexer;
  1532. stmt:TStaticLibrary;
  1533. begin
  1534. { TODO: Cleanup ignoring of FPC generated libimp*.a files}
  1535. { Don't load import libraries }
  1536. if copy(ExtractFileName(para),1,6)='libimp' then
  1537. exit;
  1538. Comment(V_Tried,'Opening library '+para);
  1539. objreader:=CArObjectreader.createAr(para,true);
  1540. if ErrorCount>0 then
  1541. exit;
  1542. if objreader.isarchive then
  1543. TFPObjectList(FGroupStack.Last).Add(TStaticLibrary.Create(para,objreader,CObjInput))
  1544. else
  1545. if CObjInput.CanReadObjData(objreader) then
  1546. begin
  1547. { may be a regular object as well as a dynamic one }
  1548. objinput:=CObjInput.Create;
  1549. if objinput.ReadObjData(objreader,objdata) then
  1550. begin
  1551. stmt:=TStaticLibrary.create_object(objdata);
  1552. stmt.AsNeeded:=asneededflag;
  1553. TFPObjectList(FGroupStack.Last).Add(stmt);
  1554. end;
  1555. objinput.Free;
  1556. objreader.Free;
  1557. end
  1558. else { try parsing as script }
  1559. begin
  1560. Comment(V_Tried,'Interpreting '+para+' as ld script');
  1561. ScriptLexer:=TScriptLexer.Create(objreader);
  1562. ParseLdScript(ScriptLexer);
  1563. ScriptLexer.Free;
  1564. objreader.Free;
  1565. end;
  1566. end;
  1567. procedure TInternalLinker.Load_Group;
  1568. var
  1569. group: TStaticLibrary;
  1570. begin
  1571. group:=TStaticLibrary.create_group;
  1572. TFPObjectList(FGroupStack.Last).Add(group);
  1573. FGroupStack.Add(group.GroupMembers);
  1574. end;
  1575. procedure TInternalLinker.Load_EndGroup;
  1576. begin
  1577. FGroupStack.Delete(FGroupStack.Count-1);
  1578. end;
  1579. procedure TInternalLinker.ParseScript_Handle;
  1580. var
  1581. s{, para}, keyword : String;
  1582. hp : TCmdStrListItem;
  1583. i : longint;
  1584. begin
  1585. hp:=TCmdStrListItem(linkscript.first);
  1586. i:=0;
  1587. while assigned(hp) do
  1588. begin
  1589. inc(i);
  1590. s:=hp.str;
  1591. if (s='') or (s[1]='#') then
  1592. begin
  1593. hp:=TCmdStrListItem(hp.next);
  1594. continue;
  1595. end;
  1596. keyword:=Upper(GetToken(s,' '));
  1597. {para:=}GetToken(s,' ');
  1598. if Trim(s)<>'' then
  1599. Comment(V_Warning,'Unknown part "'+s+'" in "'+hp.str+'" internal linker script');
  1600. if (keyword<>'SYMBOL') and
  1601. (keyword<>'SYMBOLS') and
  1602. (keyword<>'STABS') and
  1603. (keyword<>'PROVIDE') and
  1604. (keyword<>'ZEROS') and
  1605. (keyword<>'BYTE') and
  1606. (keyword<>'WORD') and
  1607. (keyword<>'LONG') and
  1608. (keyword<>'QUAD') and
  1609. (keyword<>'ENTRYNAME') and
  1610. (keyword<>'ISSHAREDLIBRARY') and
  1611. (keyword<>'IMAGEBASE') and
  1612. (keyword<>'READOBJECT') and
  1613. (keyword<>'READSTATICLIBRARY') and
  1614. (keyword<>'EXESECTION') and
  1615. (keyword<>'ENDEXESECTION') and
  1616. (keyword<>'OBJSECTION') and
  1617. (keyword<>'HEADER') and
  1618. (keyword<>'GROUP') and
  1619. (keyword<>'ENDGROUP')
  1620. then
  1621. Comment(V_Warning,'Unknown keyword "'+keyword+'" in "'+hp.str
  1622. +'" internal linker script');
  1623. hp:=TCmdStrListItem(hp.next);
  1624. end;
  1625. ScriptCount:=i;
  1626. if ScriptCount>0 then
  1627. begin
  1628. GetMem(IsHandled,sizeof(boolean)*ScriptCount);
  1629. Fillchar(IsHandled^,sizeof(boolean)*ScriptCount,#0);
  1630. end;
  1631. end;
  1632. procedure TInternalLinker.ParseScript_PostCheck;
  1633. var
  1634. hp : TCmdStrListItem;
  1635. i : longint;
  1636. begin
  1637. hp:=TCmdStrListItem(linkscript.first);
  1638. i:=0;
  1639. while assigned(hp) do
  1640. begin
  1641. inc(i);
  1642. if not IsHandled^[i] then
  1643. begin
  1644. Comment(V_Warning,'"'+hp.str+
  1645. '" internal linker script not handled');
  1646. end;
  1647. hp:=TCmdStrListItem(hp.next);
  1648. end;
  1649. end;
  1650. function TInternalLinker.ParsePara(const para : string) : string;
  1651. var
  1652. res : string;
  1653. begin
  1654. res:=trim(para);
  1655. { Remove enclosing braces }
  1656. if (length(res)>0) and (res[1]='(') and
  1657. (res[length(res)]=')') then
  1658. res:=trim(copy(res,2,length(res)-2));
  1659. result:=res;
  1660. end;
  1661. procedure TInternalLinker.ParseScript_Load;
  1662. var
  1663. s,
  1664. para,
  1665. keyword : String;
  1666. hp : TCmdStrListItem;
  1667. i : longint;
  1668. handled : boolean;
  1669. begin
  1670. exeoutput.Load_Start;
  1671. hp:=TCmdStrListItem(linkscript.first);
  1672. i:=0;
  1673. while assigned(hp) do
  1674. begin
  1675. inc(i);
  1676. s:=hp.str;
  1677. if (s='') or (s[1]='#') then
  1678. begin
  1679. IsHandled^[i]:=true;
  1680. hp:=TCmdStrListItem(hp.next);
  1681. continue;
  1682. end;
  1683. handled:=true;
  1684. keyword:=Upper(GetToken(s,' '));
  1685. para:=ParsePara(GetToken(s,' '));
  1686. if keyword='SYMBOL' then
  1687. ExeOutput.Load_Symbol(para)
  1688. else if keyword='PROVIDE' then
  1689. ExeOutput.Load_ProvideSymbol(para)
  1690. else if keyword='ENTRYNAME' then
  1691. ExeOutput.Load_EntryName(para)
  1692. else if keyword='ISSHAREDLIBRARY' then
  1693. ExeOutput.Load_IsSharedLibrary
  1694. else if keyword='IMAGEBASE' then
  1695. ExeOutput.Load_ImageBase(para)
  1696. else if keyword='READOBJECT' then
  1697. Load_ReadObject(para)
  1698. else if keyword='STABS' then
  1699. UseStabs:=true
  1700. else if keyword='READSTATICLIBRARY' then
  1701. Load_ReadStaticLibrary(para)
  1702. else if keyword='GROUP' then
  1703. Load_Group
  1704. else if keyword='ENDGROUP' then
  1705. Load_EndGroup
  1706. else
  1707. handled:=false;
  1708. if handled then
  1709. IsHandled^[i]:=true;
  1710. hp:=TCmdStrListItem(hp.next);
  1711. end;
  1712. end;
  1713. procedure TInternalLinker.ParseScript_Order;
  1714. var
  1715. s,
  1716. para,
  1717. keyword : String;
  1718. hp : TCmdStrListItem;
  1719. i : longint;
  1720. handled : boolean;
  1721. begin
  1722. exeoutput.Order_Start;
  1723. hp:=TCmdStrListItem(linkscript.first);
  1724. i:=0;
  1725. while assigned(hp) do
  1726. begin
  1727. inc(i);
  1728. s:=hp.str;
  1729. if (s='') or (s[1]='#') then
  1730. begin
  1731. hp:=TCmdStrListItem(hp.next);
  1732. continue;
  1733. end;
  1734. handled:=true;
  1735. keyword:=Upper(GetToken(s,' '));
  1736. para:=ParsePara(GetToken(s,' '));
  1737. if keyword='EXESECTION' then
  1738. ExeOutput.Order_ExeSection(para)
  1739. else if keyword='ENDEXESECTION' then
  1740. ExeOutput.Order_EndExeSection
  1741. else if keyword='OBJSECTION' then
  1742. ExeOutput.Order_ObjSection(para)
  1743. else if keyword='ZEROS' then
  1744. ExeOutput.Order_Zeros(para)
  1745. else if keyword='BYTE' then
  1746. ExeOutput.Order_Values(1,para)
  1747. else if keyword='WORD' then
  1748. ExeOutput.Order_Values(2,para)
  1749. else if keyword='LONG' then
  1750. ExeOutput.Order_Values(4,para)
  1751. else if keyword='QUAD' then
  1752. ExeOutput.Order_Values(8,para)
  1753. else if keyword='SYMBOL' then
  1754. ExeOutput.Order_Symbol(para)
  1755. else if keyword='PROVIDE' then
  1756. ExeOutput.Order_ProvideSymbol(para)
  1757. else
  1758. handled:=false;
  1759. if handled then
  1760. IsHandled^[i]:=true;
  1761. hp:=TCmdStrListItem(hp.next);
  1762. end;
  1763. exeoutput.Order_End;
  1764. end;
  1765. procedure TInternalLinker.ParseScript_MemPos;
  1766. var
  1767. s,
  1768. para,
  1769. keyword : String;
  1770. hp : TCmdStrListItem;
  1771. i : longint;
  1772. handled : boolean;
  1773. begin
  1774. exeoutput.MemPos_Start;
  1775. hp:=TCmdStrListItem(linkscript.first);
  1776. i:=0;
  1777. while assigned(hp) do
  1778. begin
  1779. inc(i);
  1780. s:=hp.str;
  1781. if (s='') or (s[1]='#') then
  1782. begin
  1783. hp:=TCmdStrListItem(hp.next);
  1784. continue;
  1785. end;
  1786. handled:=true;
  1787. keyword:=Upper(GetToken(s,' '));
  1788. para:=ParsePara(GetToken(s,' '));
  1789. if keyword='EXESECTION' then
  1790. ExeOutput.MemPos_ExeSection(para)
  1791. else if keyword='ENDEXESECTION' then
  1792. ExeOutput.MemPos_EndExeSection
  1793. else if keyword='HEADER' then
  1794. ExeOutput.MemPos_Header
  1795. else
  1796. handled:=false;
  1797. if handled then
  1798. IsHandled^[i]:=true;
  1799. hp:=TCmdStrListItem(hp.next);
  1800. end;
  1801. end;
  1802. procedure TInternalLinker.ParseScript_DataPos;
  1803. var
  1804. s,
  1805. para,
  1806. keyword : String;
  1807. hp : TCmdStrListItem;
  1808. i : longint;
  1809. handled : boolean;
  1810. begin
  1811. exeoutput.DataPos_Start;
  1812. hp:=TCmdStrListItem(linkscript.first);
  1813. i:=0;
  1814. while assigned(hp) do
  1815. begin
  1816. inc(i);
  1817. s:=hp.str;
  1818. if (s='') or (s[1]='#') then
  1819. begin
  1820. hp:=TCmdStrListItem(hp.next);
  1821. continue;
  1822. end;
  1823. handled:=true;
  1824. keyword:=Upper(GetToken(s,' '));
  1825. para:=ParsePara(GetToken(s,' '));
  1826. if keyword='EXESECTION' then
  1827. ExeOutput.DataPos_ExeSection(para)
  1828. else if keyword='ENDEXESECTION' then
  1829. ExeOutput.DataPos_EndExeSection
  1830. else if keyword='HEADER' then
  1831. ExeOutput.DataPos_Header
  1832. else if keyword='SYMBOLS' then
  1833. ExeOutput.DataPos_Symbols
  1834. else
  1835. handled:=false;
  1836. if handled then
  1837. IsHandled^[i]:=true;
  1838. hp:=TCmdStrListItem(hp.next);
  1839. end;
  1840. end;
  1841. procedure TInternalLinker.PrintLinkerScript;
  1842. var
  1843. hp : TCmdStrListItem;
  1844. begin
  1845. if not assigned(exemap) then
  1846. exit;
  1847. exemap.Add('Used linker script');
  1848. exemap.Add('');
  1849. hp:=TCmdStrListItem(linkscript.first);
  1850. while assigned(hp) do
  1851. begin
  1852. exemap.Add(hp.str);
  1853. hp:=TCmdStrListItem(hp.next);
  1854. end;
  1855. end;
  1856. function TInternalLinker.RunLinkScript(const outputname:TCmdStr):boolean;
  1857. label
  1858. myexit;
  1859. var
  1860. bsssize : qword;
  1861. dbgname : TCmdStr;
  1862. begin
  1863. result:=false;
  1864. Message1(exec_i_linking,outputname);
  1865. FlushOutput;
  1866. exeoutput:=CExeOutput.Create;
  1867. { TODO: Load custom linker script}
  1868. DefaultLinkScript;
  1869. if (cs_link_map in current_settings.globalswitches) then
  1870. exemap:=texemap.create(current_module.mapfilename);
  1871. PrintLinkerScript;
  1872. { Check that syntax is OK }
  1873. ParseScript_Handle;
  1874. { Load .o files and resolve symbols }
  1875. FGroupStack.Add(FStaticLibraryList);
  1876. ParseScript_Load;
  1877. if ErrorCount>0 then
  1878. goto myexit;
  1879. exeoutput.ResolveSymbols(StaticLibraryList);
  1880. { Generate symbols and code to do the importing }
  1881. exeoutput.GenerateLibraryImports(ImportLibraryList);
  1882. { Fill external symbols data }
  1883. exeoutput.FixupSymbols;
  1884. if ErrorCount>0 then
  1885. goto myexit;
  1886. { parse linker options specific for output format }
  1887. exeoutput.ParseScript (linkscript);
  1888. { Create .exe sections and add .o sections }
  1889. ParseScript_Order;
  1890. exeoutput.RemoveUnreferencedSections;
  1891. { if UseStabs then, this would remove
  1892. STABS for empty linker scripts }
  1893. exeoutput.MergeStabs;
  1894. exeoutput.MarkEmptySections;
  1895. exeoutput.AfterUnusedSectionRemoval;
  1896. if ErrorCount>0 then
  1897. goto myexit;
  1898. { Calc positions in mem }
  1899. ParseScript_MemPos;
  1900. exeoutput.FixupRelocations;
  1901. exeoutput.RemoveUnusedExeSymbols;
  1902. exeoutput.PrintMemoryMap;
  1903. if ErrorCount>0 then
  1904. goto myexit;
  1905. if cs_link_separate_dbg_file in current_settings.globalswitches then
  1906. begin
  1907. { create debuginfo, which is an executable without data on disk }
  1908. dbgname:=ChangeFileExt(outputname,'.dbg');
  1909. exeoutput.ExeWriteMode:=ewm_dbgonly;
  1910. ParseScript_DataPos;
  1911. exeoutput.WriteExeFile(dbgname);
  1912. { create executable with link to just created debuginfo file }
  1913. exeoutput.ExeWriteMode:=ewm_exeonly;
  1914. exeoutput.RemoveDebugInfo;
  1915. exeoutput.GenerateDebugLink(ExtractFileName(dbgname),GetFileCRC(dbgname));
  1916. ParseScript_MemPos;
  1917. ParseScript_DataPos;
  1918. exeoutput.WriteExeFile(outputname);
  1919. end
  1920. else
  1921. begin
  1922. exeoutput.ExeWriteMode:=ewm_exefull;
  1923. ParseScript_DataPos;
  1924. exeoutput.WriteExeFile(outputname);
  1925. end;
  1926. { Post check that everything was handled }
  1927. ParseScript_PostCheck;
  1928. status.codesize:=GetCodeSize(exeoutput);
  1929. status.datasize:=GetDataSize(exeoutput);
  1930. bsssize:=GetBssSize(exeoutput);
  1931. { Executable info }
  1932. Message1(execinfo_x_codesize,tostr(status.codesize));
  1933. Message1(execinfo_x_initdatasize,tostr(status.datasize));
  1934. Message1(execinfo_x_uninitdatasize,tostr(bsssize));
  1935. Message1(execinfo_x_stackreserve,tostr(stacksize));
  1936. myexit:
  1937. { close map }
  1938. if assigned(exemap) then
  1939. begin
  1940. exemap.free;
  1941. exemap:=nil;
  1942. end;
  1943. { close exe }
  1944. exeoutput.free;
  1945. exeoutput:=nil;
  1946. result:=true;
  1947. end;
  1948. function TInternalLinker.ExecutableFilename:String;
  1949. begin
  1950. result:=current_module.exefilename;
  1951. end;
  1952. function TInternalLinker.SharedLibFilename:String;
  1953. begin
  1954. result:=current_module.sharedlibfilename;
  1955. end;
  1956. function TInternalLinker.MakeExecutable:boolean;
  1957. begin
  1958. IsSharedLibrary:=false;
  1959. result:=RunLinkScript(ExecutableFilename);
  1960. {$ifdef hasUnix}
  1961. fpchmod(current_module.exefilename,493);
  1962. {$endif hasUnix}
  1963. end;
  1964. function TInternalLinker.MakeSharedLibrary:boolean;
  1965. begin
  1966. IsSharedLibrary:=true;
  1967. result:=RunLinkScript(SharedLibFilename);
  1968. end;
  1969. procedure TInternalLinker.ScriptAddGenericSections(secnames:string);
  1970. var
  1971. secname:string;
  1972. begin
  1973. repeat
  1974. secname:=gettoken(secnames,',');
  1975. if secname='' then
  1976. break;
  1977. linkscript.Concat('EXESECTION '+secname);
  1978. linkscript.Concat(' OBJSECTION '+secname+'*');
  1979. linkscript.Concat('ENDEXESECTION');
  1980. until false;
  1981. end;
  1982. {*****************************************************************************
  1983. Init/Done
  1984. *****************************************************************************}
  1985. procedure RegisterLinker(id:tlink;c:TLinkerClass);
  1986. begin
  1987. CLinker[id]:=c;
  1988. end;
  1989. procedure InitLinker;
  1990. begin
  1991. if (cs_link_extern in current_settings.globalswitches) and
  1992. assigned(CLinker[target_info.linkextern]) then
  1993. begin
  1994. linker:=CLinker[target_info.linkextern].Create;
  1995. end
  1996. else
  1997. if assigned(CLinker[target_info.link]) then
  1998. begin
  1999. linker:=CLinker[target_info.link].Create;
  2000. end
  2001. else
  2002. linker:=Tlinker.Create;
  2003. end;
  2004. procedure DoneLinker;
  2005. begin
  2006. if assigned(linker) then
  2007. Linker.Free;
  2008. end;
  2009. {*****************************************************************************
  2010. Initialize
  2011. *****************************************************************************}
  2012. const
  2013. ar_gnu_ar_info : tarinfo =
  2014. (
  2015. id : ar_gnu_ar;
  2016. addfilecmd : '';
  2017. arfirstcmd : '';
  2018. arcmd : 'ar qS $LIB $FILES';
  2019. arfinishcmd : 'ar s $LIB'
  2020. );
  2021. ar_gnu_ar_scripted_info : tarinfo =
  2022. (
  2023. id : ar_gnu_ar_scripted;
  2024. addfilecmd : '';
  2025. arfirstcmd : '';
  2026. arcmd : 'ar -M < $SCRIPT';
  2027. arfinishcmd : ''
  2028. );
  2029. ar_gnu_gar_info : tarinfo =
  2030. ( id : ar_gnu_gar;
  2031. addfilecmd : '';
  2032. arfirstcmd : '';
  2033. arcmd : 'gar qS $LIB $FILES';
  2034. arfinishcmd : 'gar s $LIB'
  2035. );
  2036. ar_watcom_wlib_omf_info : tarinfo =
  2037. ( id : ar_watcom_wlib_omf;
  2038. addfilecmd : '+';
  2039. arfirstcmd : 'wlib -q $RECSIZE -fo -c -b -n -o=$OUTPUTLIB $LIB $FILES';
  2040. arcmd : 'wlib -q $RECSIZE -fo -c -b -o=$OUTPUTLIB $LIB $FILES';
  2041. arfinishcmd : ''
  2042. );
  2043. ar_watcom_wlib_omf_scripted_info : tarinfo =
  2044. (
  2045. id : ar_watcom_wlib_omf_scripted;
  2046. addfilecmd : '+';
  2047. arfirstcmd : '';
  2048. arcmd : 'wlib @$SCRIPT';
  2049. arfinishcmd : ''
  2050. );
  2051. ar_sdcc_sdar_info : tarinfo =
  2052. ( id : ar_sdcc_sdar;
  2053. addfilecmd : '';
  2054. arfirstcmd : '';
  2055. arcmd : 'sdar qS $LIB $FILES';
  2056. arfinishcmd : 'sdar s $LIB'
  2057. );
  2058. ar_sdcc_sdar_scripted_info : tarinfo =
  2059. (
  2060. id : ar_sdcc_sdar_scripted;
  2061. addfilecmd : '';
  2062. arfirstcmd : '';
  2063. arcmd : 'sdar -M < $SCRIPT';
  2064. arfinishcmd : ''
  2065. );
  2066. initialization
  2067. RegisterAr(ar_gnu_ar_info);
  2068. RegisterAr(ar_gnu_ar_scripted_info);
  2069. RegisterAr(ar_gnu_gar_info);
  2070. RegisterAr(ar_watcom_wlib_omf_info);
  2071. RegisterAr(ar_watcom_wlib_omf_scripted_info);
  2072. RegisterAr(ar_sdcc_sdar_info);
  2073. RegisterAr(ar_sdcc_sdar_scripted_info);
  2074. end.