ogbase.pas 77 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404
  1. {
  2. Copyright (c) 1998-2006 by Peter Vreman
  3. Contains the base stuff for binary object file writers
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit ogbase;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. { common }
  22. cutils,
  23. cclasses,
  24. { targets }
  25. systems,globtype,
  26. { outputwriters }
  27. owbase,
  28. { assembler }
  29. aasmbase;
  30. type
  31. TObjSection = class;
  32. TObjData = class;
  33. TExeSection = class;
  34. TExeSymbol = class;
  35. TObjRelocationType = (
  36. { Relocation to absolute address }
  37. RELOC_ABSOLUTE,
  38. {$ifdef x86_64}
  39. { 32bit Relocation to absolute address }
  40. RELOC_ABSOLUTE32,
  41. { 64 bit coff only }
  42. RELOC_RELATIVE_1,
  43. RELOC_RELATIVE_2,
  44. RELOC_RELATIVE_3,
  45. RELOC_RELATIVE_4,
  46. RELOC_RELATIVE_5,
  47. { PIC }
  48. RELOC_GOTPCREL,
  49. RELOC_PLT32,
  50. {$endif x86_64}
  51. {$ifdef arm}
  52. RELOC_RELATIVE_24,
  53. {$endif arm}
  54. { Relative relocation }
  55. RELOC_RELATIVE,
  56. { PECoff (Windows) RVA relocation }
  57. RELOC_RVA,
  58. { Generate a 0 value at the place of the relocation,
  59. this is used to remove unused vtable entries }
  60. RELOC_ZERO,
  61. { No relocation is needed. It is used in ARM object files.
  62. Also internal linker use this reloc to make virtual (not real)
  63. links to some sections }
  64. RELOC_NONE
  65. );
  66. {$ifndef x86_64}
  67. const
  68. RELOC_ABSOLUTE32 = RELOC_ABSOLUTE;
  69. {$endif x86_64}
  70. type
  71. TObjSectionOption = (
  72. { Has Data available in the file }
  73. oso_Data,
  74. { Is loaded into memory }
  75. oso_load,
  76. { Not loaded into memory }
  77. oso_noload,
  78. { Read only }
  79. oso_readonly,
  80. { Read/Write }
  81. oso_write,
  82. { Contains executable instructions }
  83. oso_executable,
  84. { Never discard section }
  85. oso_keep,
  86. { Special common symbols }
  87. oso_common,
  88. { Contains debug info and can be stripped }
  89. oso_debug,
  90. { Contains only strings }
  91. oso_strings
  92. );
  93. TObjSectionOptions = set of TObjSectionOption;
  94. TObjSymbol = class(TFPHashObject)
  95. public
  96. bind : TAsmsymbind;
  97. typ : TAsmsymtype;
  98. { Current assemble pass, used to detect duplicate labels }
  99. pass : byte;
  100. objsection : TObjSection;
  101. symidx : longint;
  102. offset,
  103. size : aint;
  104. { Used for external and common solving during linking }
  105. exesymbol : TExeSymbol;
  106. constructor create(AList:TFPHashObjectList;const AName:string);
  107. function address:aint;
  108. procedure SetAddress(apass:byte;aobjsec:TObjSection;abind:TAsmsymbind;atyp:Tasmsymtype);
  109. end;
  110. { Stabs is common for all targets }
  111. TObjStabEntry=packed record
  112. strpos : longint;
  113. ntype : byte;
  114. nother : byte;
  115. ndesc : word;
  116. nvalue : longint;
  117. end;
  118. PObjStabEntry=^TObjStabEntry;
  119. TObjRelocation = class
  120. DataOffset,
  121. orgsize : aint; { original size of the symbol to Relocate, required for COFF }
  122. symbol : TObjSymbol;
  123. objsection : TObjSection; { only used if symbol=nil }
  124. typ : TObjRelocationType;
  125. constructor CreateSymbol(ADataOffset:aint;s:TObjSymbol;Atyp:TObjRelocationType);
  126. constructor CreateSymbolSize(ADataOffset:aint;s:TObjSymbol;Aorgsize:aint;Atyp:TObjRelocationType);
  127. constructor CreateSection(ADataOffset:aint;aobjsec:TObjSection;Atyp:TObjRelocationType);
  128. end;
  129. TObjSection = class(TFPHashObject)
  130. private
  131. FData : TDynamicArray;
  132. FSecOptions : TObjSectionOptions;
  133. FCachedFullName : pshortstring;
  134. procedure SetSecOptions(Aoptions:TObjSectionOptions);
  135. public
  136. ObjData : TObjData;
  137. SecSymIdx : longint; { index for the section in symtab }
  138. SecAlign : shortint; { alignment of the section }
  139. { section Data }
  140. Size,
  141. DataPos,
  142. MemPos : aint;
  143. DataAlignBytes : shortint;
  144. { Relocations (=references) to other sections }
  145. ObjRelocations : TFPObjectList;
  146. { Symbols this defines }
  147. ObjSymbolDefines : TFPObjectList;
  148. { executable linking }
  149. ExeSection : TExeSection;
  150. USed : Boolean;
  151. VTRefList : TFPObjectList;
  152. constructor create(AList:TFPHashObjectList;const Aname:string;Aalign:shortint;Aoptions:TObjSectionOptions);virtual;
  153. destructor destroy;override;
  154. function write(const d;l:aint):aint;
  155. function writestr(const s:string):aint;
  156. function WriteZeros(l:longint):aint;
  157. procedure setmempos(var mpos:aint);
  158. procedure setDatapos(var dpos:aint);
  159. procedure alloc(l:aint);
  160. procedure addsymReloc(ofs:aint;p:TObjSymbol;Reloctype:TObjRelocationType);
  161. procedure addsectionReloc(ofs:aint;aobjsec:TObjSection;Reloctype:TObjRelocationType);
  162. procedure AddSymbolDefine(p:TObjSymbol);
  163. procedure FixupRelocs;virtual;
  164. procedure ReleaseData;
  165. function FullName:string;
  166. property Data:TDynamicArray read FData;
  167. property SecOptions:TObjSectionOptions read FSecOptions write SetSecOptions;
  168. end;
  169. TObjSectionClass = class of TObjSection;
  170. TObjData = class(TLinkedListItem)
  171. private
  172. FName : string[80];
  173. FCurrObjSec : TObjSection;
  174. FObjSectionList : TFPHashObjectList;
  175. FCObjSection : TObjSectionClass;
  176. { Symbols that will be defined in this object file }
  177. FObjSymbolList : TFPHashObjectList;
  178. FCachedAsmSymbolList : TFPObjectList;
  179. { Special info sections that are written to during object generation }
  180. FStabsObjSec,
  181. FStabStrObjSec : TObjSection;
  182. procedure section_reset(p:TObject;arg:pointer);
  183. procedure section_afteralloc(p:TObject;arg:pointer);
  184. procedure section_afterwrite(p:TObject;arg:pointer);
  185. protected
  186. property CObjSection:TObjSectionClass read FCObjSection write FCObjSection;
  187. public
  188. CurrPass : byte;
  189. ImageBase : aint;
  190. constructor create(const n:string);virtual;
  191. destructor destroy;override;
  192. { Sections }
  193. function sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;virtual;
  194. function sectiontype2options(atype:TAsmSectiontype):TObjSectionOptions;virtual;
  195. function sectiontype2align(atype:TAsmSectiontype):shortint;virtual;
  196. function createsection(atype:TAsmSectionType;const aname:string='';aorder:TAsmSectionOrder=secorder_default):TObjSection;
  197. function createsection(const aname:string;aalign:shortint;aoptions:TObjSectionOptions):TObjSection;virtual;
  198. procedure CreateDebugSections;virtual;
  199. function findsection(const aname:string):TObjSection;
  200. procedure setsection(asec:TObjSection);
  201. { Symbols }
  202. function createsymbol(const aname:string):TObjSymbol;
  203. function symboldefine(asmsym:TAsmSymbol):TObjSymbol;
  204. function symboldefine(const aname:string;abind:TAsmsymbind;atyp:Tasmsymtype):TObjSymbol;
  205. function symbolref(asmsym:TAsmSymbol):TObjSymbol;
  206. function symbolref(const aname:string):TObjSymbol;
  207. procedure ResetCachedAsmSymbols;
  208. { Allocation }
  209. procedure alloc(len:aint);
  210. procedure allocalign(len:shortint);
  211. procedure writebytes(const Data;len:aint);
  212. procedure writeReloc(Data,len:aint;p:TObjSymbol;Reloctype:TObjRelocationType);virtual;abstract;
  213. procedure beforealloc;virtual;
  214. procedure beforewrite;virtual;
  215. procedure afteralloc;virtual;
  216. procedure afterwrite;virtual;
  217. procedure resetsections;
  218. property Name:string[80] read FName;
  219. property CurrObjSec:TObjSection read FCurrObjSec;
  220. property ObjSymbolList:TFPHashObjectList read FObjSymbolList;
  221. property ObjSectionList:TFPHashObjectList read FObjSectionList;
  222. property StabsSec:TObjSection read FStabsObjSec write FStabsObjSec;
  223. property StabStrSec:TObjSection read FStabStrObjSec write FStabStrObjSec;
  224. end;
  225. TObjDataClass = class of TObjData;
  226. TObjOutput = class
  227. private
  228. FCObjData : TObjDataClass;
  229. protected
  230. { writer }
  231. FWriter : TObjectwriter;
  232. function writeData(Data:TObjData):boolean;virtual;abstract;
  233. property CObjData : TObjDataClass read FCObjData write FCObjData;
  234. public
  235. constructor create(AWriter:TObjectWriter);virtual;
  236. destructor destroy;override;
  237. function newObjData(const n:string):TObjData;
  238. function startObjectfile(const fn:string):boolean;
  239. function writeobjectfile(Data:TObjData):boolean;
  240. procedure exportsymbol(p:TObjSymbol);
  241. property Writer:TObjectWriter read FWriter;
  242. end;
  243. TObjOutputClass=class of TObjOutput;
  244. TObjInput = class
  245. private
  246. FCObjData : TObjDataClass;
  247. protected
  248. { reader }
  249. FReader : TObjectReader;
  250. InputFileName : string;
  251. property CObjData : TObjDataClass read FCObjData write FCObjData;
  252. public
  253. constructor create;virtual;
  254. destructor destroy;override;
  255. function newObjData(const n:string):TObjData;
  256. function ReadObjData(AReader:TObjectreader;Data:TObjData):boolean;virtual;abstract;
  257. procedure inputerror(const s : string);
  258. end;
  259. TObjInputClass=class of TObjInput;
  260. TVTableEntry=record
  261. ObjRelocation : TObjRelocation;
  262. orgreloctype : TObjRelocationType;
  263. Enabled,
  264. Used : Boolean;
  265. end;
  266. PVTableEntry=^TVTableEntry;
  267. TExeVTable = class
  268. private
  269. procedure CheckIdx(VTableIdx:longint);
  270. public
  271. ExeSymbol : TExeSymbol;
  272. EntryCnt : Longint;
  273. EntryArray : PVTableEntry;
  274. Consolidated : Boolean;
  275. ChildList : TFPObjectList;
  276. constructor Create(AExeSymbol:TExeSymbol);
  277. destructor Destroy;override;
  278. procedure AddChild(vt:TExeVTable);
  279. procedure AddEntry(VTableIdx:Longint);
  280. procedure SetVTableSize(ASize:longint);
  281. function VTableRef(VTableIdx:Longint):TObjRelocation;
  282. end;
  283. TSymbolState = (symstate_undefined,symstate_defined,symstate_common);
  284. TExeSymbol = class(TFPHashObject)
  285. ObjSymbol : TObjSymbol;
  286. ExeSection : TExeSection;
  287. State : TSymbolState;
  288. { Used for vmt references optimization }
  289. VTable : TExeVTable;
  290. end;
  291. TExeSection = class(TFPHashObject)
  292. private
  293. FSecSymIdx : longint;
  294. FObjSectionList : TFPObjectList;
  295. public
  296. Size,
  297. DataPos,
  298. MemPos : aint;
  299. SecAlign : shortint;
  300. SecOptions : TObjSectionOptions;
  301. constructor create(AList:TFPHashObjectList;const AName:string);virtual;
  302. destructor destroy;override;
  303. procedure AddObjSection(objsec:TObjSection);
  304. property ObjSectionList:TFPObjectList read FObjSectionList;
  305. property SecSymIdx:longint read FSecSymIdx write FSecSymIdx;
  306. end;
  307. TExeSectionClass=class of TExeSection;
  308. TStaticLibrary = class(TFPHashObject)
  309. private
  310. FArReader : TObjectReader;
  311. FObjInputClass : TObjInputClass;
  312. public
  313. constructor create(AList:TFPHashObjectList;const AName:string;AReader:TObjectReader;AObjInputClass:TObjInputClass);
  314. destructor destroy;override;
  315. property ArReader:TObjectReader read FArReader;
  316. property ObjInputClass:TObjInputClass read FObjInputClass;
  317. end;
  318. TImportLibrary = class(TFPHashObject)
  319. private
  320. FImportSymbolList : TFPHashObjectList;
  321. public
  322. constructor create(AList:TFPHashObjectList;const AName:string);
  323. destructor destroy;override;
  324. property ImportSymbolList:TFPHashObjectList read FImportSymbolList;
  325. end;
  326. TImportSymbol = class(TFPHashObject)
  327. private
  328. FOrdNr : longint;
  329. FIsVar : boolean;
  330. public
  331. constructor create(AList:TFPHashObjectList;const AName:string;AOrdNr:longint;AIsVar:boolean);
  332. property OrdNr: longint read FOrdNr;
  333. property IsVar: boolean read FIsVar;
  334. end;
  335. TExeOutput = class
  336. private
  337. { ExeSections }
  338. FCObjData : TObjDataClass;
  339. FCExeSection : TExeSectionClass;
  340. FCurrExeSec : TExeSection;
  341. FExeSectionList : TFPHashObjectList;
  342. Fzeronr : longint;
  343. { Symbols }
  344. FExeSymbolList : TFPHashObjectList;
  345. FUnresolvedExeSymbols : TFPObjectList;
  346. FExternalObjSymbols,
  347. FCommonObjSymbols : TFPObjectList;
  348. FEntryName : string;
  349. FExeVTableList : TFPObjectList;
  350. { Objects }
  351. FObjDataList : TFPObjectList;
  352. { Position calculation }
  353. FImageBase : aint;
  354. FCurrDataPos,
  355. FCurrMemPos : aint;
  356. protected
  357. { writer }
  358. FWriter : TObjectwriter;
  359. commonObjSection : TObjSection;
  360. internalObjData : TObjData;
  361. EntrySym : TObjSymbol;
  362. SectionDataAlign,
  363. SectionMemAlign : aint;
  364. function writeData:boolean;virtual;abstract;
  365. property CExeSection:TExeSectionClass read FCExeSection write FCExeSection;
  366. property CObjData:TObjDataClass read FCObjData write FCObjData;
  367. public
  368. IsSharedLibrary : boolean;
  369. constructor create;virtual;
  370. destructor destroy;override;
  371. function FindExeSection(const aname:string):TExeSection;
  372. procedure AddObjData(ObjData:TObjData);
  373. procedure Load_Start;virtual;
  374. procedure Load_EntryName(const aname:string);virtual;
  375. procedure Load_Symbol(const aname:string);virtual;
  376. procedure Load_IsSharedLibrary;
  377. procedure Load_ImageBase(const avalue:string);
  378. procedure Order_Start;virtual;
  379. procedure Order_End;virtual;
  380. procedure Order_ExeSection(const aname:string);virtual;
  381. procedure Order_Align(const aname:string);virtual;
  382. procedure Order_Zeros(const aname:string);virtual;
  383. procedure Order_Symbol(const aname:string);virtual;
  384. procedure Order_EndExeSection;virtual;
  385. procedure Order_ObjSection(const aname:string);virtual;
  386. procedure CalcPos_ExeSection(const aname:string);virtual;
  387. procedure CalcPos_EndExeSection;virtual;
  388. procedure CalcPos_Header;virtual;
  389. procedure CalcPos_Start;virtual;
  390. procedure CalcPos_Symbols;virtual;
  391. procedure BuildVTableTree(VTInheritList,VTEntryList:TFPObjectList);
  392. procedure PackUnresolvedExeSymbols(const s:string);
  393. procedure ResolveSymbols(StaticLibraryList:TFPHashObjectList);
  394. procedure PrintMemoryMap;
  395. procedure FixupSymbols;
  396. procedure FixupRelocations;
  397. procedure MergeStabs;
  398. procedure RemoveUnreferencedSections;
  399. procedure RemoveEmptySections;
  400. procedure GenerateLibraryImports(ImportLibraryList:TFPHashObjectList);virtual;
  401. function writeexefile(const fn:string):boolean;
  402. property Writer:TObjectWriter read FWriter;
  403. property ExeSections:TFPHashObjectList read FExeSectionList;
  404. property ObjDataList:TFPObjectList read FObjDataList;
  405. property ExeSymbolList:TFPHashObjectList read FExeSymbolList;
  406. property UnresolvedExeSymbols:TFPObjectList read FUnresolvedExeSymbols;
  407. property ExternalObjSymbols:TFPObjectList read FExternalObjSymbols;
  408. property CommonObjSymbols:TFPObjectList read FCommonObjSymbols;
  409. property ExeVTableList:TFPObjectList read FExeVTableList;
  410. property EntryName:string read FEntryName write FEntryName;
  411. property ImageBase:aint read FImageBase write FImageBase;
  412. property CurrExeSec:TExeSection read FCurrExeSec;
  413. property CurrDataPos:aint read FCurrDataPos write FCurrDataPos;
  414. property CurrMemPos:aint read FCurrMemPos write FCurrMemPos;
  415. end;
  416. TExeOutputClass=class of TExeOutput;
  417. var
  418. exeoutput : TExeOutput;
  419. implementation
  420. uses
  421. SysUtils,
  422. globals,verbose,fmodule,ogmap;
  423. const
  424. SectionDataMaxGrow = 4096;
  425. {$ifdef MEMDEBUG}
  426. var
  427. memobjsymbols,
  428. memobjsections : TMemDebug;
  429. {$endif MEMDEBUG}
  430. {*****************************************************************************
  431. TObjSymbol
  432. *****************************************************************************}
  433. constructor TObjSymbol.create(AList:TFPHashObjectList;const AName:string);
  434. begin;
  435. inherited create(AList,AName);
  436. bind:=AB_EXTERNAL;
  437. typ:=AT_NONE;
  438. symidx:=-1;
  439. size:=0;
  440. offset:=0;
  441. objsection:=nil;
  442. end;
  443. function TObjSymbol.address:aint;
  444. begin
  445. if assigned(objsection) then
  446. result:=offset+objsection.mempos
  447. else
  448. result:=0;
  449. end;
  450. procedure TObjSymbol.SetAddress(apass:byte;aobjsec:TObjSection;abind:TAsmsymbind;atyp:Tasmsymtype);
  451. begin
  452. if not(abind in [AB_GLOBAL,AB_LOCAL,AB_COMMON]) then
  453. internalerror(200603016);
  454. if not assigned(aobjsec) then
  455. internalerror(200603017);
  456. if (bind=AB_EXTERNAL) then
  457. begin
  458. bind:=abind;
  459. typ:=atyp;
  460. end
  461. else
  462. begin
  463. if pass=apass then
  464. Message1(asmw_e_duplicate_label,name);
  465. end;
  466. pass:=apass;
  467. { Code can never grow after a pass }
  468. if assigned(objsection) and
  469. (aobjsec.size>offset) then
  470. internalerror(200603014);
  471. objsection:=aobjsec;
  472. offset:=aobjsec.size;
  473. end;
  474. {****************************************************************************
  475. TObjRelocation
  476. ****************************************************************************}
  477. constructor TObjRelocation.CreateSymbol(ADataOffset:aint;s:TObjSymbol;Atyp:TObjRelocationType);
  478. begin
  479. if not assigned(s) then
  480. internalerror(200603034);
  481. DataOffset:=ADataOffset;
  482. Symbol:=s;
  483. OrgSize:=0;
  484. ObjSection:=nil;
  485. Typ:=Atyp;
  486. end;
  487. constructor TObjRelocation.CreateSymbolSize(ADataOffset:aint;s:TObjSymbol;Aorgsize:aint;Atyp:TObjRelocationType);
  488. begin
  489. if not assigned(s) then
  490. internalerror(200603035);
  491. DataOffset:=ADataOffset;
  492. Symbol:=s;
  493. OrgSize:=Aorgsize;
  494. ObjSection:=nil;
  495. Typ:=Atyp;
  496. end;
  497. constructor TObjRelocation.CreateSection(ADataOffset:aint;aobjsec:TObjSection;Atyp:TObjRelocationType);
  498. begin
  499. if not assigned(aobjsec) then
  500. internalerror(200603036);
  501. DataOffset:=ADataOffset;
  502. Symbol:=nil;
  503. OrgSize:=0;
  504. ObjSection:=aobjsec;
  505. Typ:=Atyp;
  506. end;
  507. {****************************************************************************
  508. TObjSection
  509. ****************************************************************************}
  510. constructor TObjSection.create(AList:TFPHashObjectList;const Aname:string;Aalign:shortint;Aoptions:TObjSectionOptions);
  511. begin
  512. inherited Create(AList,Aname);
  513. { Data }
  514. Size:=0;
  515. Datapos:=0;
  516. mempos:=0;
  517. FData:=Nil;
  518. { Setting the secoptions allocates Data if needed }
  519. secoptions:=Aoptions;
  520. secalign:=Aalign;
  521. secsymidx:=0;
  522. { relocation }
  523. ObjRelocations:=TFPObjectList.Create(true);
  524. ObjSymbolDefines:=TFPObjectList.Create(false);
  525. VTRefList:=TFPObjectList.Create(false);
  526. end;
  527. destructor TObjSection.destroy;
  528. begin
  529. if assigned(Data) then
  530. Data.Free;
  531. ObjRelocations.Free;
  532. ObjSymbolDefines.Free;
  533. VTRefList.Free;
  534. inherited destroy;
  535. end;
  536. procedure TObjSection.SetSecOptions(Aoptions:TObjSectionOptions);
  537. begin
  538. FSecOptions:=FSecOptions+AOptions;
  539. if (oso_Data in secoptions) and
  540. not assigned(FData) then
  541. FData:=TDynamicArray.Create(SectionDataMaxGrow);
  542. end;
  543. function TObjSection.write(const d;l:aint):aint;
  544. begin
  545. result:=size;
  546. if assigned(Data) then
  547. begin
  548. if Size<>Data.size then
  549. internalerror(200602281);
  550. Data.write(d,l);
  551. inc(Size,l);
  552. end
  553. else
  554. internalerror(200602289);
  555. end;
  556. function TObjSection.writestr(const s:string):aint;
  557. begin
  558. result:=Write(s[1],length(s));
  559. end;
  560. function TObjSection.WriteZeros(l:longint):aint;
  561. var
  562. empty : array[0..1023] of byte;
  563. begin
  564. if l>sizeof(empty) then
  565. internalerror(200404082);
  566. if l>0 then
  567. begin
  568. fillchar(empty,l,0);
  569. result:=Write(empty,l);
  570. end
  571. else
  572. result:=Size;
  573. end;
  574. procedure TObjSection.setDatapos(var dpos:aint);
  575. begin
  576. if oso_Data in secoptions then
  577. begin
  578. { get aligned Datapos }
  579. Datapos:=align(dpos,secalign);
  580. Dataalignbytes:=Datapos-dpos;
  581. { return updated Datapos }
  582. dpos:=Datapos+size;
  583. end
  584. else
  585. Datapos:=dpos;
  586. end;
  587. procedure TObjSection.setmempos(var mpos:aint);
  588. begin
  589. mempos:=align(mpos,secalign);
  590. { return updated mempos }
  591. mpos:=mempos+size;
  592. end;
  593. procedure TObjSection.alloc(l:aint);
  594. begin
  595. inc(size,l);
  596. end;
  597. procedure TObjSection.addsymReloc(ofs:aint;p:TObjSymbol;Reloctype:TObjRelocationType);
  598. begin
  599. ObjRelocations.Add(TObjRelocation.CreateSymbol(ofs,p,reloctype));
  600. end;
  601. procedure TObjSection.addsectionReloc(ofs:aint;aobjsec:TObjSection;Reloctype:TObjRelocationType);
  602. begin
  603. ObjRelocations.Add(TObjRelocation.CreateSection(ofs,aobjsec,reloctype));
  604. end;
  605. procedure TObjSection.AddSymbolDefine(p:TObjSymbol);
  606. begin
  607. if p.bind<>AB_GLOBAL then
  608. exit;
  609. ObjSymbolDefines.Add(p);
  610. end;
  611. procedure TObjSection.FixupRelocs;
  612. begin
  613. end;
  614. procedure TObjSection.ReleaseData;
  615. begin
  616. if assigned(FData) then
  617. begin
  618. FData.free;
  619. FData:=nil;
  620. end;
  621. ObjRelocations.free;
  622. ObjRelocations:=nil;
  623. ObjSymbolDefines.Free;
  624. ObjSymbolDefines:=nil;
  625. if assigned(FCachedFullName) then
  626. begin
  627. stringdispose(FCachedFullName);
  628. FCachedFullName:=nil;
  629. end;
  630. end;
  631. function TObjSection.FullName:string;
  632. begin
  633. if not assigned(FCachedFullName) then
  634. begin
  635. if assigned(ObjData) then
  636. FCachedFullName:=stringdup(ObjData.Name+'('+Name+')')
  637. else
  638. FCachedFullName:=stringdup(Name);
  639. end;
  640. result:=FCachedFullName^;
  641. end;
  642. {****************************************************************************
  643. TObjData
  644. ****************************************************************************}
  645. constructor TObjData.create(const n:string);
  646. begin
  647. inherited create;
  648. FName:=ExtractFileName(n);
  649. FObjSectionList:=TFPHashObjectList.Create(true);
  650. FStabsObjSec:=nil;
  651. FStabStrObjSec:=nil;
  652. { symbols }
  653. FObjSymbolList:=TFPHashObjectList.Create(true);
  654. FCachedAsmSymbolList:=TFPObjectList.Create(false);
  655. { section class type for creating of new sections }
  656. FCObjSection:=TObjSection;
  657. end;
  658. destructor TObjData.destroy;
  659. begin
  660. { Symbols }
  661. {$ifdef MEMDEBUG}
  662. MemObjSymbols.Start;
  663. {$endif}
  664. ResetCachedAsmSymbols;
  665. FCachedAsmSymbolList.free;
  666. FObjSymbolList.free;
  667. {$ifdef MEMDEBUG}
  668. MemObjSymbols.Stop;
  669. {$endif}
  670. { Sections }
  671. {$ifdef MEMDEBUG}
  672. MemObjSections.Start;
  673. {$endif}
  674. FObjSectionList.free;
  675. {$ifdef MEMDEBUG}
  676. MemObjSections.Stop;
  677. {$endif}
  678. inherited destroy;
  679. end;
  680. function TObjData.sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;
  681. const
  682. secnames : array[TAsmSectiontype] of string[16] = ('',
  683. 'code',
  684. 'Data',
  685. 'roData',
  686. 'bss',
  687. 'threadvar',
  688. 'pdata',
  689. 'stub',
  690. 'stab','stabstr',
  691. 'iData2','iData4','iData5','iData6','iData7','eData',
  692. 'eh_frame',
  693. 'debug_frame','debug_info','debug_line','debug_abbrev',
  694. 'fpc',
  695. 'toc'
  696. );
  697. var
  698. sep : string[3];
  699. begin
  700. if aname<>'' then
  701. begin
  702. case aorder of
  703. secorder_begin :
  704. sep:='.b_';
  705. secorder_end :
  706. sep:='.z_';
  707. else
  708. sep:='.n_';
  709. end;
  710. result:=secnames[atype]+sep+aname
  711. end
  712. else
  713. result:=secnames[atype];
  714. end;
  715. function TObjData.sectiontype2options(atype:TAsmSectiontype):TObjSectionOptions;
  716. const
  717. secoptions : array[TAsmSectiontype] of TObjSectionOptions = ([],
  718. {code} [oso_Data,oso_load,oso_readonly,oso_executable,oso_keep],
  719. {Data} [oso_Data,oso_load,oso_write,oso_keep],
  720. {$warning TODO Fix roData be read-only}
  721. {roData} [oso_Data,oso_load,oso_write,oso_keep],
  722. {bss} [oso_load,oso_write,oso_keep],
  723. {threadvar} [oso_load,oso_write],
  724. {pdata} [oso_load,oso_readonly,oso_keep],
  725. {stub} [oso_Data,oso_load,oso_readonly,oso_executable],
  726. {stab} [oso_Data,oso_noload,oso_debug],
  727. {stabstr} [oso_Data,oso_noload,oso_strings,oso_debug],
  728. {iData2} [oso_Data,oso_load,oso_write],
  729. {iData4} [oso_Data,oso_load,oso_write],
  730. {iData5} [oso_Data,oso_load,oso_write],
  731. {iData6} [oso_Data,oso_load,oso_write],
  732. {iData7} [oso_Data,oso_load,oso_write],
  733. {eData} [oso_Data,oso_load,oso_readonly],
  734. {eh_frame} [oso_Data,oso_load,oso_readonly],
  735. {debug_frame} [oso_Data,oso_noload,oso_debug],
  736. {debug_info} [oso_Data,oso_noload,oso_debug],
  737. {debug_line} [oso_Data,oso_noload,oso_debug],
  738. {debug_abbrev} [oso_Data,oso_noload,oso_debug],
  739. {fpc} [oso_Data,oso_load,oso_write,oso_keep],
  740. {toc} [oso_Data,oso_load,oso_readonly]
  741. );
  742. begin
  743. result:=secoptions[atype];
  744. end;
  745. function TObjData.sectiontype2align(atype:TAsmSectiontype):shortint;
  746. begin
  747. case atype of
  748. sec_stabstr,sec_debug_info,sec_debug_line,sec_debug_abbrev:
  749. result:=1;
  750. sec_code,
  751. sec_bss,
  752. sec_data:
  753. result:=16;
  754. else
  755. result:=sizeof(aint);
  756. end;
  757. end;
  758. function TObjData.createsection(atype:TAsmSectionType;const aname:string;aorder:TAsmSectionOrder):TObjSection;
  759. begin
  760. result:=createsection(sectionname(atype,aname,aorder),sectiontype2align(atype),sectiontype2options(atype));
  761. end;
  762. function TObjData.createsection(const aname:string;aalign:shortint;aoptions:TObjSectionOptions):TObjSection;
  763. begin
  764. result:=TObjSection(FObjSectionList.Find(aname));
  765. if not assigned(result) then
  766. begin
  767. result:=CObjSection.create(FObjSectionList,aname,aalign,aoptions);
  768. result.ObjData:=self;
  769. end;
  770. FCurrObjSec:=result;
  771. end;
  772. procedure TObjData.CreateDebugSections;
  773. begin
  774. end;
  775. function TObjData.FindSection(const aname:string):TObjSection;
  776. begin
  777. result:=TObjSection(FObjSectionList.Find(aname));
  778. end;
  779. procedure TObjData.setsection(asec:TObjSection);
  780. begin
  781. if asec.ObjData<>self then
  782. internalerror(200403041);
  783. FCurrObjSec:=asec;
  784. end;
  785. function TObjData.createsymbol(const aname:string):TObjSymbol;
  786. begin
  787. result:=TObjSymbol(FObjSymbolList.Find(aname));
  788. if not assigned(result) then
  789. result:=TObjSymbol.Create(FObjSymbolList,aname);
  790. end;
  791. function TObjData.symboldefine(asmsym:TAsmSymbol):TObjSymbol;
  792. begin
  793. if assigned(asmsym) then
  794. begin
  795. if not assigned(asmsym.cachedObjSymbol) then
  796. begin
  797. result:=symboldefine(asmsym.name,asmsym.bind,asmsym.typ);
  798. asmsym.cachedObjSymbol:=result;
  799. FCachedAsmSymbolList.add(asmsym);
  800. end
  801. else
  802. begin
  803. result:=TObjSymbol(asmsym.cachedObjSymbol);
  804. result.SetAddress(CurrPass,CurrObjSec,asmsym.bind,asmsym.typ);
  805. { Register also in TObjSection }
  806. CurrObjSec.AddSymbolDefine(result);
  807. end;
  808. end
  809. else
  810. result:=nil;
  811. end;
  812. function TObjData.symboldefine(const aname:string;abind:TAsmsymbind;atyp:Tasmsymtype):TObjSymbol;
  813. begin
  814. if not assigned(CurrObjSec) then
  815. internalerror(200603051);
  816. result:=CreateSymbol(aname);
  817. { Register also in TObjSection }
  818. CurrObjSec.AddSymbolDefine(result);
  819. result.SetAddress(CurrPass,CurrObjSec,abind,atyp);
  820. end;
  821. function TObjData.symbolref(asmsym:TAsmSymbol):TObjSymbol;
  822. begin
  823. if assigned(asmsym) then
  824. begin
  825. if not assigned(asmsym.cachedObjSymbol) then
  826. begin
  827. result:=symbolref(asmsym.name);
  828. asmsym.cachedObjSymbol:=result;
  829. FCachedAsmSymbolList.add(asmsym);
  830. end
  831. else
  832. result:=TObjSymbol(asmsym.cachedObjSymbol);
  833. end
  834. else
  835. result:=nil;
  836. end;
  837. function TObjData.symbolref(const aname:string):TObjSymbol;
  838. begin
  839. if not assigned(CurrObjSec) then
  840. internalerror(200603052);
  841. result:=CreateSymbol(aname);
  842. end;
  843. procedure TObjData.ResetCachedAsmSymbols;
  844. var
  845. i : longint;
  846. begin
  847. for i:=0 to FCachedAsmSymbolList.Count-1 do
  848. tasmsymbol(FCachedAsmSymbolList[i]).cachedObjSymbol:=nil;
  849. FCachedAsmSymbolList.Clear;
  850. end;
  851. procedure TObjData.writebytes(const Data;len:aint);
  852. begin
  853. if not assigned(CurrObjSec) then
  854. internalerror(200402251);
  855. CurrObjSec.write(Data,len);
  856. end;
  857. procedure TObjData.alloc(len:aint);
  858. begin
  859. if not assigned(CurrObjSec) then
  860. internalerror(200402252);
  861. CurrObjSec.alloc(len);
  862. end;
  863. procedure TObjData.allocalign(len:shortint);
  864. begin
  865. if not assigned(CurrObjSec) then
  866. internalerror(200402253);
  867. CurrObjSec.alloc(align(CurrObjSec.size,len)-CurrObjSec.size);
  868. end;
  869. procedure TObjData.section_afteralloc(p:TObject;arg:pointer);
  870. begin
  871. with TObjSection(p) do
  872. alloc(align(size,secalign)-size);
  873. end;
  874. procedure TObjData.section_afterwrite(p:TObject;arg:pointer);
  875. begin
  876. with TObjSection(p) do
  877. begin
  878. if assigned(Data) then
  879. writezeros(align(size,secalign)-size);
  880. end;
  881. end;
  882. procedure TObjData.section_reset(p:TObject;arg:pointer);
  883. begin
  884. with TObjSection(p) do
  885. begin
  886. Size:=0;
  887. Datapos:=0;
  888. mempos:=0;
  889. end;
  890. end;
  891. procedure TObjData.beforealloc;
  892. begin
  893. { create stabs sections if debugging }
  894. if assigned(StabsSec) then
  895. begin
  896. StabsSec.Alloc(sizeof(TObjStabEntry));
  897. StabStrSec.Alloc(1);
  898. end;
  899. end;
  900. procedure TObjData.beforewrite;
  901. var
  902. s : string[1];
  903. hstab : TObjStabEntry;
  904. begin
  905. { create stabs sections if debugging }
  906. if assigned(StabsSec) then
  907. begin
  908. { Create dummy HdrSym stab, it will be overwritten in AfterWrite }
  909. fillchar(hstab,sizeof(hstab),0);
  910. StabsSec.Write(hstab,sizeof(hstab));
  911. { start of stabstr }
  912. s:=#0;
  913. StabStrSec.write(s[1],length(s));
  914. end;
  915. end;
  916. procedure TObjData.afteralloc;
  917. begin
  918. FObjSectionList.ForEachCall(@section_afteralloc,nil);
  919. end;
  920. procedure TObjData.afterwrite;
  921. var
  922. s : string[1];
  923. hstab : TObjStabEntry;
  924. begin
  925. FObjSectionList.ForEachCall(@section_afterwrite,nil);
  926. { For the stab section we need an HdrSym which can now be
  927. calculated more easily }
  928. if assigned(StabsSec) then
  929. begin
  930. { end of stabstr }
  931. s:=#0;
  932. StabStrSec.write(s[1],length(s));
  933. { header stab }
  934. hstab.strpos:=1;
  935. hstab.ntype:=0;
  936. hstab.nother:=0;
  937. hstab.ndesc:=(StabsSec.Size div sizeof(TObjStabEntry))-1;
  938. hstab.nvalue:=StabStrSec.Size;
  939. StabsSec.Data.seek(0);
  940. StabsSec.Data.write(hstab,sizeof(hstab));
  941. end;
  942. end;
  943. procedure TObjData.resetsections;
  944. begin
  945. FObjSectionList.ForEachCall(@section_reset,nil);
  946. end;
  947. {****************************************************************************
  948. TObjOutput
  949. ****************************************************************************}
  950. constructor TObjOutput.create(AWriter:TObjectWriter);
  951. begin
  952. FWriter:=AWriter;
  953. CObjData:=TObjData;
  954. end;
  955. destructor TObjOutput.destroy;
  956. begin
  957. inherited destroy;
  958. end;
  959. function TObjOutput.newObjData(const n:string):TObjData;
  960. begin
  961. result:=CObjData.create(n);
  962. if (cs_use_lineinfo in current_settings.globalswitches) or
  963. (cs_debuginfo in current_settings.moduleswitches) then
  964. result.CreateDebugSections;
  965. end;
  966. function TObjOutput.startObjectfile(const fn:string):boolean;
  967. begin
  968. result:=false;
  969. { start the writer already, so the .a generation can initialize
  970. the position of the current objectfile }
  971. if not FWriter.createfile(fn) then
  972. Comment(V_Fatal,'Can''t create object '+fn);
  973. result:=true;
  974. end;
  975. function TObjOutput.writeobjectfile(Data:TObjData):boolean;
  976. begin
  977. if errorcount=0 then
  978. result:=writeData(Data)
  979. else
  980. result:=true;
  981. { close the writer }
  982. FWriter.closefile;
  983. end;
  984. procedure TObjOutput.exportsymbol(p:TObjSymbol);
  985. begin
  986. { export globals and common symbols, this is needed
  987. for .a files }
  988. if p.bind in [AB_GLOBAL,AB_COMMON] then
  989. FWriter.writesym(p.name);
  990. end;
  991. {****************************************************************************
  992. TExeVTable
  993. ****************************************************************************}
  994. constructor TExeVTable.Create(AExeSymbol:TExeSymbol);
  995. begin
  996. ExeSymbol:=AExeSymbol;
  997. if ExeSymbol.State=symstate_undefined then
  998. internalerror(200604012);
  999. ChildList:=TFPObjectList.Create(false);
  1000. end;
  1001. destructor TExeVTable.Destroy;
  1002. begin
  1003. ChildList.Free;
  1004. if assigned(EntryArray) then
  1005. Freemem(EntryArray);
  1006. end;
  1007. procedure TExeVTable.CheckIdx(VTableIdx:longint);
  1008. var
  1009. OldEntryCnt : longint;
  1010. begin
  1011. if VTableIdx>=EntryCnt then
  1012. begin
  1013. OldEntryCnt:=EntryCnt;
  1014. EntryCnt:=VTableIdx+1;
  1015. ReAllocMem(EntryArray,EntryCnt*sizeof(TVTableEntry));
  1016. FillChar(EntryArray[OldEntryCnt],(EntryCnt-OldEntryCnt)*sizeof(TVTableEntry),0);
  1017. end;
  1018. end;
  1019. procedure TExeVTable.AddChild(vt:TExeVTable);
  1020. begin
  1021. ChildList.Add(vt);
  1022. end;
  1023. procedure TExeVTable.AddEntry(VTableIdx:Longint);
  1024. var
  1025. i : longint;
  1026. objreloc : TObjRelocation;
  1027. vtblentryoffset : aint;
  1028. begin
  1029. CheckIdx(VTableIdx);
  1030. vtblentryoffset:=ExeSymbol.ObjSymbol.Offset+VTableIdx*sizeof(aint);
  1031. { Find and disable relocation }
  1032. for i:=0 to ExeSymbol.ObjSymbol.ObjSection.ObjRelocations.Count-1 do
  1033. begin
  1034. objreloc:=TObjRelocation(ExeSymbol.ObjSymbol.ObjSection.ObjRelocations[i]);
  1035. if objreloc.dataoffset=vtblentryoffset then
  1036. begin
  1037. EntryArray[VTableIdx].ObjRelocation:=objreloc;
  1038. EntryArray[VTableIdx].OrgRelocType:=objreloc.typ;
  1039. objreloc.typ:=RELOC_ZERO;
  1040. break;
  1041. end;
  1042. end;
  1043. if not assigned(EntryArray[VTableIdx].ObjRelocation) then
  1044. internalerror(200604011);
  1045. end;
  1046. procedure TExeVTable.SetVTableSize(ASize:longint);
  1047. begin
  1048. if EntryCnt<>0 then
  1049. internalerror(200603313);
  1050. EntryCnt:=ASize div sizeof(aint);
  1051. EntryArray:=AllocMem(EntryCnt*sizeof(TVTableEntry));
  1052. end;
  1053. function TExeVTable.VTableRef(VTableIdx:Longint):TObjRelocation;
  1054. begin
  1055. result:=nil;
  1056. CheckIdx(VTableIdx);
  1057. if EntryArray[VTableIdx].Used then
  1058. exit;
  1059. { Restore relocation if available }
  1060. if assigned(EntryArray[VTableIdx].ObjRelocation) then
  1061. begin
  1062. EntryArray[VTableIdx].ObjRelocation.typ:=EntryArray[VTableIdx].OrgRelocType;
  1063. result:=EntryArray[VTableIdx].ObjRelocation;
  1064. end;
  1065. EntryArray[VTableIdx].Used:=true;
  1066. end;
  1067. {****************************************************************************
  1068. TExeSection
  1069. ****************************************************************************}
  1070. constructor TExeSection.create(AList:TFPHashObjectList;const AName:string);
  1071. begin
  1072. inherited create(AList,AName);
  1073. Size:=0;
  1074. MemPos:=0;
  1075. DataPos:=0;
  1076. FSecSymIdx:=0;
  1077. FObjSectionList:=TFPObjectList.Create(false);
  1078. end;
  1079. destructor TExeSection.destroy;
  1080. begin
  1081. ObjSectionList.Free;
  1082. inherited destroy;
  1083. end;
  1084. procedure TExeSection.AddObjSection(objsec:TObjSection);
  1085. begin
  1086. ObjSectionList.Add(objsec);
  1087. if (SecOptions<>[]) then
  1088. begin
  1089. { Only if the section contains (un)initialized data the
  1090. data flag must match. This check is not needed if the
  1091. section is empty for a symbol allocation }
  1092. if (objsec.size>0) and
  1093. ((oso_Data in SecOptions)<>(oso_Data in objsec.SecOptions)) then
  1094. Comment(V_Error,'Incompatible section options');
  1095. end
  1096. else
  1097. begin
  1098. { inherit section options }
  1099. SecAlign:=objsec.SecAlign;
  1100. SecOptions:=SecOptions+objsec.SecOptions;
  1101. end;
  1102. { relate ObjSection to ExeSection, and mark it Used by default }
  1103. objsec.ExeSection:=self;
  1104. objsec.Used:=true;
  1105. end;
  1106. {****************************************************************************
  1107. TStaticLibrary
  1108. ****************************************************************************}
  1109. constructor TStaticLibrary.create(AList:TFPHashObjectList;const AName:string;AReader:TObjectReader;AObjInputClass:TObjInputClass);
  1110. begin
  1111. inherited create(AList,AName);
  1112. FArReader:=AReader;
  1113. FObjInputClass:=AObjInputClass;
  1114. end;
  1115. destructor TStaticLibrary.destroy;
  1116. begin
  1117. ArReader.Free;
  1118. inherited destroy;
  1119. end;
  1120. {****************************************************************************
  1121. TImportLibrary
  1122. ****************************************************************************}
  1123. constructor TImportLibrary.create(AList:TFPHashObjectList;const AName:string);
  1124. begin
  1125. inherited create(AList,AName);
  1126. FImportSymbolList:=TFPHashObjectList.Create(false);
  1127. end;
  1128. destructor TImportLibrary.destroy;
  1129. begin
  1130. ImportSymbolList.Free;
  1131. inherited destroy;
  1132. end;
  1133. {****************************************************************************
  1134. TImportSymbol
  1135. ****************************************************************************}
  1136. constructor TImportSymbol.create(AList:TFPHashObjectList;const AName:string;AOrdNr:longint;AIsVar:boolean);
  1137. begin
  1138. inherited Create(AList, AName);
  1139. FOrdNr:=AOrdNr;
  1140. FIsVar:=AIsVar;
  1141. end;
  1142. {****************************************************************************
  1143. TExeOutput
  1144. ****************************************************************************}
  1145. constructor TExeOutput.create;
  1146. begin
  1147. { init writer }
  1148. FWriter:=TObjectwriter.create;
  1149. { object files }
  1150. FObjDataList:=TFPObjectList.Create(true);
  1151. { symbols }
  1152. FExeSymbolList:=TFPHashObjectList.Create(true);
  1153. FUnresolvedExeSymbols:=TFPObjectList.Create(false);
  1154. FExternalObjSymbols:=TFPObjectList.Create(false);
  1155. FCommonObjSymbols:=TFPObjectList.Create(false);
  1156. FExeVTableList:=TFPObjectList.Create(false);
  1157. FEntryName:='start';
  1158. { sections }
  1159. FExeSectionList:=TFPHashObjectList.Create(true);
  1160. FImageBase:=0;
  1161. SectionMemAlign:=$1000;
  1162. SectionDataAlign:=$200;
  1163. FCExeSection:=TExeSection;
  1164. FCObjData:=TObjData;
  1165. end;
  1166. destructor TExeOutput.destroy;
  1167. begin
  1168. FExeSymbolList.free;
  1169. UnresolvedExeSymbols.free;
  1170. ExternalObjSymbols.free;
  1171. CommonObjSymbols.free;
  1172. ExeVTableList.free;
  1173. FExeSectionList.free;
  1174. ObjDatalist.free;
  1175. FWriter.free;
  1176. inherited destroy;
  1177. end;
  1178. function TExeOutput.writeexefile(const fn:string):boolean;
  1179. begin
  1180. result:=false;
  1181. if FWriter.createfile(fn) then
  1182. begin
  1183. { Only write the .o if there are no errors }
  1184. if errorcount=0 then
  1185. result:=writeData
  1186. else
  1187. result:=true;
  1188. { close the writer }
  1189. FWriter.closefile;
  1190. end
  1191. else
  1192. Comment(V_Fatal,'Can''t create executable '+fn);
  1193. end;
  1194. function TExeOutput.FindExeSection(const aname:string):TExeSection;
  1195. begin
  1196. result:=TExeSection(FExeSectionList.Find(aname));
  1197. end;
  1198. procedure TExeOutput.AddObjData(ObjData:TObjData);
  1199. begin
  1200. if ObjData.classtype<>FCObjData then
  1201. Comment(V_Error,'Invalid input object format for '+ObjData.name+' got '+ObjData.classname+' expected '+FCObjData.classname);
  1202. ObjDataList.Add(ObjData);
  1203. end;
  1204. procedure TExeOutput.Load_Start;
  1205. begin
  1206. ObjDataList.Clear;
  1207. { Globals defined in the linker script }
  1208. if not assigned(internalObjData) then
  1209. internalObjData:=CObjData.create('*Internal*');
  1210. AddObjData(internalObjData);
  1211. { Common Data section }
  1212. commonObjSection:=internalObjData.createsection(sec_bss,'');
  1213. end;
  1214. procedure TExeOutput.Load_EntryName(const aname:string);
  1215. begin
  1216. EntryName:=aname;
  1217. end;
  1218. procedure TExeOutput.Load_IsSharedLibrary;
  1219. begin
  1220. IsSharedLibrary:=true;
  1221. end;
  1222. procedure TExeOutput.Load_ImageBase(const avalue:string);
  1223. var
  1224. code : integer;
  1225. objsec : TObjSection;
  1226. objsym : TObjSymbol;
  1227. exesym : TExeSymbol;
  1228. begin
  1229. val(avalue,ImageBase,code);
  1230. { Create __image_base__ symbol, create the symbol
  1231. in a section with adress 0 and at offset 0 }
  1232. objsec:=internalObjData.createsection('*__image_base__',0,[]);
  1233. internalObjData.setsection(objsec);
  1234. objsym:=internalObjData.SymbolDefine('__image_base__',AB_GLOBAL,AT_FUNCTION);
  1235. exesym:=texesymbol.Create(FExeSymbolList,objsym.name);
  1236. exesym.ObjSymbol:=objsym;
  1237. end;
  1238. procedure TExeOutput.Load_Symbol(const aname:string);
  1239. begin
  1240. internalObjData.createsection('*'+aname,0,[]);
  1241. internalObjData.SymbolDefine(aname,AB_GLOBAL,AT_FUNCTION);
  1242. end;
  1243. procedure TExeOutput.Order_Start;
  1244. begin
  1245. end;
  1246. procedure TExeOutput.Order_End;
  1247. begin
  1248. internalObjData.afterwrite;
  1249. end;
  1250. procedure TExeOutput.Order_ExeSection(const aname:string);
  1251. var
  1252. sec : TExeSection;
  1253. begin
  1254. sec:=FindExeSection(aname);
  1255. if not assigned(sec) then
  1256. sec:=CExeSection.create(FExeSectionList,aname);
  1257. { Clear ExeSection contents }
  1258. FCurrExeSec:=sec;
  1259. end;
  1260. procedure TExeOutput.Order_EndExeSection;
  1261. begin
  1262. if not assigned(CurrExeSec) then
  1263. internalerror(200602184);
  1264. FCurrExeSec:=nil;
  1265. end;
  1266. function ObjSectionNameCompare(Item1, Item2: Pointer): Integer;
  1267. var
  1268. I1 : TObjSection absolute Item1;
  1269. I2 : TObjSection absolute Item2;
  1270. begin
  1271. Result:=CompareStr(I1.FullName,I2.FullName);
  1272. end;
  1273. procedure TExeOutput.Order_ObjSection(const aname:string);
  1274. var
  1275. i,j : longint;
  1276. ObjData : TObjData;
  1277. objsec : TObjSection;
  1278. TmpObjSectionList : TFPObjectList;
  1279. begin
  1280. if not assigned(CurrExeSec) then
  1281. internalerror(200602181);
  1282. TmpObjSectionList:=TFPObjectList.Create(false);
  1283. for i:=0 to ObjDataList.Count-1 do
  1284. begin
  1285. ObjData:=TObjData(ObjDataList[i]);
  1286. for j:=0 to ObjData.ObjSectionList.Count-1 do
  1287. begin
  1288. objsec:=TObjSection(ObjData.ObjSectionList[j]);
  1289. if (not objsec.Used) and
  1290. MatchPattern(aname,objsec.name) then
  1291. TmpObjSectionList.Add(objsec);
  1292. end;
  1293. end;
  1294. { Sort list if needed }
  1295. TmpObjSectionList.Sort(@ObjSectionNameCompare);
  1296. { Add the (sorted) list to the current ExeSection }
  1297. for i:=0 to TmpObjSectionList.Count-1 do
  1298. begin
  1299. objsec:=TObjSection(TmpObjSectionList[i]);
  1300. CurrExeSec.AddObjSection(objsec);
  1301. end;
  1302. end;
  1303. procedure TExeOutput.Order_Symbol(const aname:string);
  1304. var
  1305. ObjSection : TObjSection;
  1306. begin
  1307. ObjSection:=internalObjData.findsection('*'+aname);
  1308. if not assigned(ObjSection) then
  1309. internalerror(200603041);
  1310. CurrExeSec.AddObjSection(ObjSection);
  1311. end;
  1312. procedure TExeOutput.Order_Align(const aname:string);
  1313. var
  1314. code : integer;
  1315. alignval : shortint;
  1316. objsec : TObjSection;
  1317. begin
  1318. val(aname,alignval,code);
  1319. if alignval<=0 then
  1320. exit;
  1321. { Create an empty section with the required aligning }
  1322. inc(Fzeronr);
  1323. objsec:=internalObjData.createsection('*align'+tostr(Fzeronr),alignval,CurrExeSec.SecOptions+[oso_Data,oso_keep]);
  1324. CurrExeSec.AddObjSection(objsec);
  1325. end;
  1326. procedure TExeOutput.Order_Zeros(const aname:string);
  1327. var
  1328. zeros : array[0..1023] of byte;
  1329. code : integer;
  1330. len : longint;
  1331. objsec : TObjSection;
  1332. begin
  1333. val(aname,len,code);
  1334. if len<=0 then
  1335. exit;
  1336. if len>sizeof(zeros) then
  1337. internalerror(200602254);
  1338. fillchar(zeros,len,0);
  1339. inc(Fzeronr);
  1340. objsec:=internalObjData.createsection('*zeros'+tostr(Fzeronr),0,CurrExeSec.SecOptions+[oso_Data,oso_keep]);
  1341. internalObjData.writebytes(zeros,len);
  1342. CurrExeSec.AddObjSection(objsec);
  1343. end;
  1344. procedure TExeOutput.CalcPos_ExeSection(const aname:string);
  1345. var
  1346. i : longint;
  1347. objsec : TObjSection;
  1348. begin
  1349. { Section can be removed }
  1350. FCurrExeSec:=FindExeSection(aname);
  1351. if not assigned(CurrExeSec) then
  1352. exit;
  1353. { Alignment of ExeSection }
  1354. CurrMemPos:=align(CurrMemPos,SectionMemAlign);
  1355. CurrExeSec.MemPos:=CurrMemPos;
  1356. if (oso_Data in currexesec.SecOptions) then
  1357. begin
  1358. CurrDataPos:=align(CurrDataPos,SectionDataAlign);
  1359. CurrExeSec.DataPos:=CurrDataPos;
  1360. end;
  1361. { set position of object ObjSections }
  1362. for i:=0 to CurrExeSec.ObjSectionList.Count-1 do
  1363. begin
  1364. objsec:=TObjSection(CurrExeSec.ObjSectionList[i]);
  1365. { Position in memory }
  1366. objsec.setmempos(CurrMemPos);
  1367. { Position in File }
  1368. if (oso_Data in objsec.SecOptions) then
  1369. begin
  1370. if not (oso_Data in currexesec.SecOptions) then
  1371. internalerror(200603043);
  1372. if not assigned(objsec.Data) then
  1373. internalerror(200603044);
  1374. objsec.setDatapos(CurrDataPos);
  1375. end;
  1376. end;
  1377. { calculate size of the section }
  1378. CurrExeSec.Size:=CurrMemPos-CurrExeSec.MemPos;
  1379. end;
  1380. procedure TExeOutput.CalcPos_EndExeSection;
  1381. begin
  1382. if not assigned(CurrExeSec) then
  1383. exit;
  1384. FCurrExeSec:=nil;
  1385. end;
  1386. procedure TExeOutput.CalcPos_Start;
  1387. begin
  1388. CurrMemPos:=0;
  1389. CurrDataPos:=0;
  1390. end;
  1391. procedure TExeOutput.CalcPos_Header;
  1392. begin
  1393. end;
  1394. procedure TExeOutput.CalcPos_Symbols;
  1395. begin
  1396. end;
  1397. procedure TExeOutput.BuildVTableTree(VTInheritList,VTEntryList:TFPObjectList);
  1398. var
  1399. hs : string;
  1400. code : integer;
  1401. i,k,
  1402. vtableidx : longint;
  1403. vtableexesym,
  1404. childexesym,
  1405. parentexesym : TExeSymbol;
  1406. objsym : TObjSymbol;
  1407. begin
  1408. { Build inheritance tree from VTINHERIT }
  1409. for i:=0 to VTInheritList.Count-1 do
  1410. begin
  1411. objsym:=TObjSymbol(VTInheritList[i]);
  1412. hs:=objsym.name;
  1413. { VTINHERIT_<ChildVMTName>$$<ParentVMTName> }
  1414. Delete(hs,1,Pos('_',hs));
  1415. k:=Pos('$$',hs);
  1416. if k=0 then
  1417. internalerror(200603311);
  1418. childexesym:=texesymbol(FExeSymbolList.Find(Copy(hs,1,k-1)));
  1419. parentexesym:=texesymbol(FExeSymbolList.Find(Copy(hs,k+2,length(hs)-k-1)));
  1420. if not assigned(childexesym) or
  1421. not assigned(parentexesym)then
  1422. internalerror(200603312);
  1423. if not assigned(childexesym.vtable) then
  1424. begin
  1425. childexesym.vtable:=TExeVTable.Create(childexesym);
  1426. ExeVTableList.Add(childexesym.vtable);
  1427. end;
  1428. if not assigned(parentexesym.vtable) then
  1429. begin
  1430. parentexesym.vtable:=TExeVTable.Create(parentexesym);
  1431. ExeVTableList.Add(parentexesym.vtable);
  1432. end;
  1433. childexesym.vtable.SetVTableSize(childexesym.ObjSymbol.Size);
  1434. if parentexesym<>childexesym then
  1435. parentexesym.vtable.AddChild(childexesym.vtable);
  1436. end;
  1437. { Find VTable entries from VTENTRY }
  1438. for i:=0 to VTEntryList.Count-1 do
  1439. begin
  1440. objsym:=TObjSymbol(VTEntryList[i]);
  1441. hs:=objsym.name;
  1442. { VTENTRY_<VTableName>$$<Index> }
  1443. Delete(hs,1,Pos('_',hs));
  1444. k:=Pos('$$',hs);
  1445. if k=0 then
  1446. internalerror(200603319);
  1447. vtableexesym:=texesymbol(FExeSymbolList.Find(Copy(hs,1,k-1)));
  1448. val(Copy(hs,k+2,length(hs)-k-1),vtableidx,code);
  1449. if (code<>0) then
  1450. internalerror(200603318);
  1451. if not assigned(vtableexesym) then
  1452. internalerror(2006033110);
  1453. vtableexesym.vtable.AddEntry(vtableidx);
  1454. end;
  1455. end;
  1456. procedure TExeOutput.PackUnresolvedExeSymbols(const s:string);
  1457. var
  1458. i : longint;
  1459. exesym : TExeSymbol;
  1460. begin
  1461. { Generate a list of Unresolved External symbols }
  1462. for i:=0 to UnresolvedExeSymbols.count-1 do
  1463. begin
  1464. exesym:=TExeSymbol(UnresolvedExeSymbols[i]);
  1465. if exesym.State<>symstate_undefined then
  1466. UnresolvedExeSymbols[i]:=nil;
  1467. end;
  1468. UnresolvedExeSymbols.Pack;
  1469. Comment(V_Debug,'Number of unresolved externals '+s+' '+tostr(UnresolvedExeSymbols.Count));
  1470. end;
  1471. procedure TExeOutput.ResolveSymbols(StaticLibraryList:TFPHashObjectList);
  1472. var
  1473. ObjData : TObjData;
  1474. exesym : TExeSymbol;
  1475. objsym,
  1476. commonsym : TObjSymbol;
  1477. objinput : TObjInput;
  1478. StaticLibrary : TStaticLibrary;
  1479. firstarchive,
  1480. firstcommon : boolean;
  1481. i,j : longint;
  1482. VTEntryList,
  1483. VTInheritList : TFPObjectList;
  1484. procedure LoadObjDataSymbols(ObjData:TObjData);
  1485. var
  1486. j : longint;
  1487. hs : string;
  1488. exesym : TExeSymbol;
  1489. objsym : TObjSymbol;
  1490. begin
  1491. for j:=0 to ObjData.ObjSymbolList.Count-1 do
  1492. begin
  1493. objsym:=TObjSymbol(ObjData.ObjSymbolList[j]);
  1494. { From the local symbols we are only interressed in the
  1495. VTENTRY and VTINHERIT symbols }
  1496. if objsym.bind=AB_LOCAL then
  1497. begin
  1498. if cs_link_opt_vtable in current_settings.globalswitches then
  1499. begin
  1500. hs:=objsym.name;
  1501. if (hs[1]='V') then
  1502. begin
  1503. if Copy(hs,1,5)='VTREF' then
  1504. begin
  1505. if not assigned(objsym.ObjSection.VTRefList) then
  1506. objsym.ObjSection.VTRefList:=TFPObjectList.Create(false);
  1507. objsym.ObjSection.VTRefList.Add(objsym);
  1508. end
  1509. else if Copy(hs,1,7)='VTENTRY' then
  1510. VTEntryList.Add(objsym)
  1511. else if Copy(hs,1,9)='VTINHERIT' then
  1512. VTInheritList.Add(objsym);
  1513. end;
  1514. end;
  1515. continue;
  1516. end;
  1517. { Search for existing exesymbol }
  1518. exesym:=texesymbol(FExeSymbolList.Find(objsym.name));
  1519. if not assigned(exesym) then
  1520. begin
  1521. exesym:=texesymbol.Create(FExeSymbolList,objsym.name);
  1522. exesym.ObjSymbol:=objsym;
  1523. end;
  1524. objsym.ExeSymbol:=exesym;
  1525. case objsym.bind of
  1526. AB_GLOBAL :
  1527. begin
  1528. if exesym.State<>symstate_defined then
  1529. begin
  1530. exesym.ObjSymbol:=objsym;
  1531. exesym.State:=symstate_defined;
  1532. end
  1533. else
  1534. Comment(V_Error,'Multiple defined symbol '+objsym.name);
  1535. end;
  1536. AB_EXTERNAL :
  1537. begin
  1538. ExternalObjSymbols.add(objsym);
  1539. { Register unresolved symbols only the first time they
  1540. are registered }
  1541. if exesym.ObjSymbol=objsym then
  1542. UnresolvedExeSymbols.Add(exesym);
  1543. end;
  1544. AB_COMMON :
  1545. begin
  1546. if exesym.State=symstate_undefined then
  1547. begin
  1548. exesym.ObjSymbol:=objsym;
  1549. exesym.State:=symstate_common;
  1550. end;
  1551. CommonObjSymbols.add(objsym);
  1552. end;
  1553. end;
  1554. end;
  1555. end;
  1556. begin
  1557. VTEntryList:=TFPObjectList.Create(false);
  1558. VTInheritList:=TFPObjectList.Create(false);
  1559. {
  1560. The symbol resolving is done in 3 steps:
  1561. 1. Register symbols from objects
  1562. 2. Find symbols in static libraries
  1563. 3. Define stil undefined common symbols
  1564. }
  1565. { Step 1, Register symbols from objects }
  1566. for i:=0 to ObjDataList.Count-1 do
  1567. begin
  1568. ObjData:=TObjData(ObjDataList[i]);
  1569. LoadObjDataSymbols(ObjData);
  1570. end;
  1571. PackUnresolvedExeSymbols('in objects');
  1572. { Step 2, Find unresolved symbols in the libraries }
  1573. firstarchive:=true;
  1574. for i:=0 to StaticLibraryList.Count-1 do
  1575. begin
  1576. StaticLibrary:=TStaticLibrary(StaticLibraryList[i]);
  1577. { Process list of Unresolved External symbols, we need
  1578. to use a while loop because the list can be extended when
  1579. we load members from the library. }
  1580. j:=0;
  1581. while (j<UnresolvedExeSymbols.count) do
  1582. begin
  1583. exesym:=TExeSymbol(UnresolvedExeSymbols[j]);
  1584. { Check first if the symbol is still undefined }
  1585. if exesym.State=symstate_undefined then
  1586. begin
  1587. if StaticLibrary.ArReader.OpenFile(exesym.name) then
  1588. begin
  1589. if assigned(exemap) then
  1590. begin
  1591. if firstarchive then
  1592. begin
  1593. exemap.Add('');
  1594. exemap.Add('Archive member included because of file (symbol)');
  1595. exemap.Add('');
  1596. firstarchive:=false;
  1597. end;
  1598. exemap.Add(StaticLibrary.ArReader.FileName+' - '+{exesym.ObjSymbol.ObjSection.FullName+}'('+exesym.Name+')');
  1599. end;
  1600. objinput:=StaticLibrary.ObjInputClass.Create;
  1601. objdata:=objinput.newObjData(StaticLibrary.ArReader.FileName);
  1602. objinput.ReadObjData(StaticLibrary.ArReader,objdata);
  1603. objinput.free;
  1604. AddObjData(objdata);
  1605. LoadObjDataSymbols(objdata);
  1606. StaticLibrary.ArReader.CloseFile;
  1607. end;
  1608. end;
  1609. inc(j);
  1610. end;
  1611. end;
  1612. PackUnresolvedExeSymbols('after static libraries');
  1613. { Step 3, Match common symbols or add to the globals }
  1614. firstcommon:=true;
  1615. for i:=0 to CommonObjSymbols.count-1 do
  1616. begin
  1617. objsym:=TObjSymbol(CommonObjSymbols[i]);
  1618. if objsym.exesymbol.State=symstate_defined then
  1619. begin
  1620. if objsym.exesymbol.ObjSymbol.size<>objsym.size then
  1621. Comment(V_Debug,'Size of common symbol '+objsym.name+' is different, expected '+tostr(objsym.size)+' got '+tostr(objsym.exesymbol.ObjSymbol.size));
  1622. end
  1623. else
  1624. begin
  1625. { allocate new objsymbol in .bss of *COMMON* and assign
  1626. it to the exesymbol }
  1627. if firstcommon then
  1628. begin
  1629. if assigned(exemap) then
  1630. exemap.AddCommonSymbolsHeader;
  1631. firstcommon:=false;
  1632. end;
  1633. internalObjData.setsection(commonObjSection);
  1634. commonsym:=internalObjData.symboldefine(objsym.name,AB_GLOBAL,AT_FUNCTION);
  1635. commonsym.size:=objsym.size;
  1636. internalObjData.alloc(objsym.size);
  1637. if assigned(exemap) then
  1638. exemap.AddCommonSymbol(commonsym);
  1639. { Assign to the exesymbol }
  1640. objsym.exesymbol.objsymbol:=commonsym;
  1641. objsym.exesymbol.state:=symstate_defined;
  1642. end;
  1643. end;
  1644. PackUnresolvedExeSymbols('after defining COMMON symbols');
  1645. { Find entry symbol and print in map }
  1646. exesym:=texesymbol(ExeSymbolList.Find(EntryName));
  1647. if assigned(exesym) then
  1648. begin
  1649. EntrySym:=exesym.ObjSymbol;
  1650. if assigned(exemap) then
  1651. begin
  1652. exemap.Add('');
  1653. exemap.Add('Entry symbol '+EntryName);
  1654. end;
  1655. end
  1656. else
  1657. Comment(V_Error,'Entrypoint '+EntryName+' not defined');
  1658. { Generate VTable tree }
  1659. if cs_link_opt_vtable in current_settings.globalswitches then
  1660. BuildVTableTree(VTInheritList,VTEntryList);
  1661. VTInheritList.Free;
  1662. VTEntryList.Free;
  1663. end;
  1664. procedure TExeOutput.GenerateLibraryImports(ImportLibraryList:TFPHashObjectList);
  1665. begin
  1666. end;
  1667. procedure TExeOutput.PrintMemoryMap;
  1668. var
  1669. exesec : TExeSection;
  1670. objsec : TObjSection;
  1671. objsym : TObjSymbol;
  1672. i,j,k : longint;
  1673. begin
  1674. if not assigned(exemap) then
  1675. exit;
  1676. exemap.AddMemoryMapHeader(ImageBase);
  1677. for i:=0 to ExeSections.Count-1 do
  1678. begin
  1679. exesec:=TExeSection(ExeSections[i]);
  1680. exemap.AddMemoryMapExeSection(exesec);
  1681. for j:=0 to exesec.ObjSectionList.count-1 do
  1682. begin
  1683. objsec:=TObjSection(exesec.ObjSectionList[j]);
  1684. exemap.AddMemoryMapObjectSection(objsec);
  1685. for k:=0 to objsec.ObjSymbolDefines.Count-1 do
  1686. begin
  1687. objsym:=TObjSymbol(objsec.ObjSymbolDefines[k]);
  1688. exemap.AddMemoryMapSymbol(objsym);
  1689. end;
  1690. end;
  1691. end;
  1692. end;
  1693. procedure TExeOutput.FixupSymbols;
  1694. procedure UpdateSymbol(objsym:TObjSymbol);
  1695. begin
  1696. objsym.bind:=objsym.ExeSymbol.ObjSymbol.bind;
  1697. objsym.offset:=objsym.ExeSymbol.ObjSymbol.offset;
  1698. objsym.size:=objsym.ExeSymbol.ObjSymbol.size;
  1699. objsym.typ:=objsym.ExeSymbol.ObjSymbol.typ;
  1700. objsym.ObjSection:=objsym.ExeSymbol.ObjSymbol.ObjSection;
  1701. end;
  1702. var
  1703. i : longint;
  1704. objsym : TObjSymbol;
  1705. exesym : TExeSymbol;
  1706. begin
  1707. { Print list of Unresolved External symbols }
  1708. for i:=0 to UnresolvedExeSymbols.count-1 do
  1709. begin
  1710. exesym:=TExeSymbol(UnresolvedExeSymbols[i]);
  1711. if exesym.State<>symstate_defined then
  1712. Comment(V_Error,'Undefined symbol: '+exesym.name);
  1713. end;
  1714. { Update ImageBase to ObjData so it can access from ObjSymbols }
  1715. for i:=0 to ObjDataList.Count-1 do
  1716. TObjData(ObjDataList[i]).imagebase:=imagebase;
  1717. {
  1718. Fixing up symbols is done in the following steps:
  1719. 1. Update common references
  1720. 2. Update external references
  1721. }
  1722. { Step 1, Update commons }
  1723. for i:=0 to CommonObjSymbols.count-1 do
  1724. begin
  1725. objsym:=TObjSymbol(CommonObjSymbols[i]);
  1726. if objsym.bind<>AB_COMMON then
  1727. internalerror(200606241);
  1728. UpdateSymbol(objsym);
  1729. end;
  1730. { Step 2, Update externals }
  1731. for i:=0 to ExternalObjSymbols.count-1 do
  1732. begin
  1733. objsym:=TObjSymbol(ExternalObjSymbols[i]);
  1734. if objsym.bind<>AB_EXTERNAL then
  1735. internalerror(200606242);
  1736. UpdateSymbol(objsym);
  1737. end;
  1738. end;
  1739. procedure TExeOutput.MergeStabs;
  1740. var
  1741. stabexesec,
  1742. stabstrexesec : TExeSection;
  1743. relocsec,
  1744. currstabsec,
  1745. currstabstrsec,
  1746. mergedstabsec,
  1747. mergedstabstrsec : TObjSection;
  1748. hstabreloc,
  1749. currstabreloc : TObjRelocation;
  1750. currstabrelocidx,
  1751. i,j,
  1752. mergestabcnt,
  1753. stabcnt : longint;
  1754. skipstab : boolean;
  1755. hstab : TObjStabEntry;
  1756. stabrelocofs : longint;
  1757. buf : array[0..1023] of byte;
  1758. bufend,
  1759. bufsize : longint;
  1760. begin
  1761. stabexesec:=FindExeSection('.stab');
  1762. stabstrexesec:=FindExeSection('.stabstr');
  1763. if (stabexesec=nil) or
  1764. (stabstrexesec=nil) or
  1765. (stabexesec.ObjSectionlist.count=0) then
  1766. exit;
  1767. { Create new stabsection }
  1768. stabRelocofs:=pointer(@hstab.nvalue)-@hstab;
  1769. mergedstabsec:=internalObjData.CreateSection(sec_stab,'');
  1770. mergedstabstrsec:=internalObjData.CreateSection(sec_stabstr,'');
  1771. { write stab for hdrsym }
  1772. fillchar(hstab,sizeof(TObjStabEntry),0);
  1773. mergedstabsec.write(hstab,sizeof(TObjStabEntry));
  1774. mergestabcnt:=1;
  1775. { .stabstr starts with a #0 }
  1776. buf[0]:=0;
  1777. mergedstabstrsec.write(buf[0],1);
  1778. { Copy stabs and corresponding Relocations }
  1779. for i:=0 to stabexesec.ObjSectionList.Count-1 do
  1780. begin
  1781. currstabsec:=TObjSection(stabexesec.ObjSectionList[i]);
  1782. currstabstrsec:=currstabsec.ObjData.findsection('.stabstr');
  1783. if assigned(currstabstrsec) then
  1784. begin
  1785. stabcnt:=currstabsec.Data.size div sizeof(TObjStabEntry);
  1786. currstabsec.Data.seek(0);
  1787. currstabrelocidx:=0;
  1788. for j:=0 to stabcnt-1 do
  1789. begin
  1790. hstabreloc:=nil;
  1791. skipstab:=false;
  1792. currstabsec.Data.read(hstab,sizeof(TObjStabEntry));
  1793. { Only include first hdrsym stab }
  1794. if hstab.ntype=0 then
  1795. skipstab:=true;
  1796. if not skipstab then
  1797. begin
  1798. { Find corresponding Relocation }
  1799. currstabreloc:=nil;
  1800. while (currstabrelocidx<currstabsec.ObjRelocations.Count) do
  1801. begin
  1802. currstabreloc:=TObjRelocation(currstabsec.ObjRelocations[currstabrelocidx]);
  1803. if assigned(currstabreloc) and
  1804. (currstabreloc.dataoffset>=j*sizeof(TObjStabEntry)+stabrelocofs) then
  1805. break;
  1806. inc(currstabrelocidx);
  1807. end;
  1808. if assigned(currstabreloc) and
  1809. (currstabreloc.dataoffset=j*sizeof(TObjStabEntry)+stabrelocofs) then
  1810. begin
  1811. hstabReloc:=currstabReloc;
  1812. inc(currstabrelocidx);
  1813. end;
  1814. { Check if the stab is refering to a removed section }
  1815. if assigned(hstabreloc) then
  1816. begin
  1817. if assigned(hstabreloc.Symbol) then
  1818. relocsec:=hstabreloc.Symbol.ObjSection
  1819. else
  1820. relocsec:=hstabreloc.ObjSection;
  1821. if not assigned(relocsec) then
  1822. internalerror(200603302);
  1823. if not relocsec.Used then
  1824. skipstab:=true;
  1825. end;
  1826. end;
  1827. if not skipstab then
  1828. begin
  1829. { Copy string in stabstr }
  1830. if hstab.strpos<>0 then
  1831. begin
  1832. currstabstrsec.Data.seek(hstab.strpos);
  1833. hstab.strpos:=mergedstabstrsec.Size;
  1834. repeat
  1835. bufsize:=currstabstrsec.Data.read(buf,sizeof(buf));
  1836. bufend:=indexbyte(buf,bufsize,0);
  1837. if bufend=-1 then
  1838. bufend:=bufsize
  1839. else
  1840. begin
  1841. { include the #0 }
  1842. inc(bufend);
  1843. end;
  1844. mergedstabstrsec.write(buf,bufend);
  1845. until (buf[bufend-1]=0) or (bufsize<sizeof(buf));
  1846. end;
  1847. { Copy and Update the relocation }
  1848. if assigned(hstabreloc) then
  1849. begin
  1850. hstabreloc.Dataoffset:=mergestabcnt*sizeof(TObjStabEntry)+stabRelocofs;
  1851. { Remove from List without freeing the object }
  1852. currstabsec.ObjRelocations.List[currstabrelocidx-1]:=nil;
  1853. mergedstabsec.ObjRelocations.Add(hstabreloc);
  1854. end;
  1855. { Write updated stab }
  1856. mergedstabsec.write(hstab,sizeof(hstab));
  1857. inc(mergestabcnt);
  1858. end;
  1859. end;
  1860. end;
  1861. { Unload stabs }
  1862. if assigned(currstabstrsec) then
  1863. begin
  1864. currstabstrsec.Used:=False;
  1865. currstabstrsec.ReleaseData;
  1866. end;
  1867. currstabsec.Used:=false;
  1868. currstabsec.ReleaseData;
  1869. end;
  1870. { Generate new HdrSym }
  1871. if mergedstabsec.Size>0 then
  1872. begin
  1873. hstab.strpos:=1;
  1874. hstab.ntype:=0;
  1875. hstab.nother:=0;
  1876. hstab.ndesc:=word(mergestabcnt-1);
  1877. hstab.nvalue:=mergedstabstrsec.Size;
  1878. mergedstabsec.Data.seek(0);
  1879. mergedstabsec.Data.write(hstab,sizeof(hstab));
  1880. end;
  1881. { Replace all sections with our combined stabsec }
  1882. stabexesec.ObjSectionList.Clear;
  1883. stabstrexesec.ObjSectionList.Clear;
  1884. stabexesec.AddObjSection(mergedstabsec);
  1885. stabstrexesec.AddObjSection(mergedstabstrsec);
  1886. end;
  1887. procedure TExeOutput.RemoveEmptySections;
  1888. var
  1889. i : longint;
  1890. exesec : TExeSection;
  1891. begin
  1892. for i:=0 to ExeSections.Count-1 do
  1893. begin
  1894. exesec:=TExeSection(ExeSections[i]);
  1895. if not(oso_keep in exesec.SecOptions) and
  1896. (
  1897. (exesec.ObjSectionlist.count=0) or
  1898. (
  1899. (cs_link_strip in current_settings.globalswitches) and
  1900. (oso_debug in exesec.SecOptions)
  1901. )
  1902. ) then
  1903. begin
  1904. Comment(V_Debug,'Deleting empty section '+exesec.name);
  1905. FExeSectionList.Delete(i);
  1906. end;
  1907. end;
  1908. ExeSections.Pack;
  1909. end;
  1910. procedure TExeOutput.RemoveUnreferencedSections;
  1911. var
  1912. ObjSectionWorkList : TFPObjectList;
  1913. procedure AddToObjSectionWorkList(aobjsec:TObjSection);
  1914. begin
  1915. if not aobjsec.Used then
  1916. begin
  1917. aobjsec.Used:=true;
  1918. ObjSectionWorkList.Add(aobjsec);
  1919. end;
  1920. end;
  1921. procedure DoReloc(objreloc:TObjRelocation);
  1922. var
  1923. objsym : TObjSymbol;
  1924. refobjsec : TObjSection;
  1925. begin
  1926. { Disabled Relocation to 0 }
  1927. if objreloc.typ=RELOC_ZERO then
  1928. exit;
  1929. if assigned(objreloc.symbol) then
  1930. begin
  1931. objsym:=objreloc.symbol;
  1932. if objsym.bind<>AB_LOCAL then
  1933. begin
  1934. if not(assigned(objsym.exesymbol) and
  1935. (objsym.exesymbol.State=symstate_defined)) then
  1936. internalerror(200603063);
  1937. objsym:=objsym.exesymbol.objsymbol;
  1938. end;
  1939. if not assigned(objsym.objsection) then
  1940. internalerror(200603062);
  1941. refobjsec:=objsym.objsection;
  1942. end
  1943. else
  1944. if assigned(objreloc.objsection) then
  1945. refobjsec:=objreloc.objsection
  1946. else
  1947. internalerror(200603316);
  1948. if assigned(exemap) then
  1949. exemap.Add(' References '+refobjsec.fullname);
  1950. AddToObjSectionWorkList(refobjsec);
  1951. end;
  1952. procedure DoVTableRef(vtable:TExeVTable;VTableIdx:longint);
  1953. var
  1954. i : longint;
  1955. objreloc : TObjRelocation;
  1956. begin
  1957. objreloc:=vtable.VTableRef(VTableIdx);
  1958. if assigned(objreloc) then
  1959. begin
  1960. { Process the relocation now if the ObjSection is
  1961. already processed and marked as used. Otherwise we leave it
  1962. unprocessed. It'll then be resolved when the ObjSection is
  1963. changed to Used }
  1964. if vtable.ExeSymbol.ObjSymbol.ObjSection.Used then
  1965. DoReloc(objreloc);
  1966. end;
  1967. { This recursive walking is done here instead of
  1968. in TExeVTable.VTableRef because we can now process
  1969. all needed relocations }
  1970. for i:=0 to vtable.ChildList.Count-1 do
  1971. DoVTableRef(TExeVTable(vtable.ChildList[i]),VTableIdx);
  1972. end;
  1973. var
  1974. hs : string;
  1975. i,j,k : longint;
  1976. exesec : TExeSection;
  1977. objdata : TObjData;
  1978. objsec : TObjSection;
  1979. objsym : TObjSymbol;
  1980. code : integer;
  1981. vtableidx : longint;
  1982. vtableexesym : TExeSymbol;
  1983. begin
  1984. ObjSectionWorkList:=TFPObjectList.Create(false);
  1985. if assigned(exemap) then
  1986. exemap.AddHeader('Removing unreferenced sections');
  1987. { Initialize by marking all sections unused and
  1988. adding the sections with oso_keep flags to the ObjSectionWorkList }
  1989. for i:=0 to ObjDataList.Count-1 do
  1990. begin
  1991. ObjData:=TObjData(ObjDataList[i]);
  1992. for j:=0 to ObjData.ObjSectionList.Count-1 do
  1993. begin
  1994. objsec:=TObjSection(ObjData.ObjSectionList[j]);
  1995. objsec.Used:=false;
  1996. {$warning TODO remove debug section always keep}
  1997. if oso_debug in objsec.secoptions then
  1998. objsec.Used:=true;
  1999. if (oso_keep in objsec.secoptions) then
  2000. AddToObjSectionWorkList(objsec);
  2001. end;
  2002. end;
  2003. AddToObjSectionWorkList(entrysym.exesymbol.objsymbol.objsection);
  2004. { Process all sections, add new sections to process based
  2005. on the symbol references }
  2006. while ObjSectionWorkList.Count>0 do
  2007. begin
  2008. objsec:=TObjSection(ObjSectionWorkList.Last);
  2009. if assigned(exemap) then
  2010. exemap.Add('Keeping '+objsec.FullName+' '+ToStr(objsec.ObjRelocations.Count)+' references');
  2011. ObjSectionWorkList.Delete(ObjSectionWorkList.Count-1);
  2012. { Process Relocations }
  2013. for i:=0 to objsec.ObjRelocations.count-1 do
  2014. DoReloc(TObjRelocation(objsec.ObjRelocations[i]));
  2015. { Process Virtual Entry calls }
  2016. if cs_link_opt_vtable in current_settings.globalswitches then
  2017. begin
  2018. for i:=0 to objsec.VTRefList.count-1 do
  2019. begin
  2020. objsym:=TObjSymbol(objsec.VTRefList[i]);
  2021. hs:=objsym.name;
  2022. Delete(hs,1,Pos('_',hs));
  2023. k:=Pos('$$',hs);
  2024. if k=0 then
  2025. internalerror(200603314);
  2026. vtableexesym:=texesymbol(FExeSymbolList.Find(Copy(hs,1,k-1)));
  2027. val(Copy(hs,k+2,length(hs)-k-1),vtableidx,code);
  2028. if (code<>0) then
  2029. internalerror(200603317);
  2030. if not assigned(vtableexesym) then
  2031. internalerror(200603315);
  2032. if not assigned(vtableexesym.vtable) then
  2033. internalerror(200603316);
  2034. DoVTableRef(vtableexesym.vtable,vtableidx);
  2035. end;
  2036. end;
  2037. end;
  2038. ObjSectionWorkList.Free;
  2039. ObjSectionWorkList:=nil;
  2040. { Remove unused objsections from exesections }
  2041. for i:=0 to ExeSections.Count-1 do
  2042. begin
  2043. exesec:=TExeSection(ExeSections[i]);
  2044. for j:=0 to exesec.ObjSectionlist.count-1 do
  2045. begin
  2046. objsec:=TObjSection(exesec.ObjSectionlist[j]);
  2047. if not objsec.used then
  2048. begin
  2049. if assigned(exemap) then
  2050. exemap.Add('Removing '+objsec.FullName);
  2051. exesec.ObjSectionlist[j]:=nil;
  2052. objsec.ReleaseData;
  2053. end;
  2054. end;
  2055. exesec.ObjSectionlist.Pack;
  2056. end;
  2057. end;
  2058. procedure TExeOutput.FixupRelocations;
  2059. var
  2060. i,j : longint;
  2061. exesec : TExeSection;
  2062. objsec : TObjSection;
  2063. begin
  2064. for i:=0 to ExeSections.Count-1 do
  2065. begin
  2066. exesec:=TExeSection(ExeSections[i]);
  2067. if not assigned(exesec) then
  2068. continue;
  2069. for j:=0 to exesec.ObjSectionlist.count-1 do
  2070. begin
  2071. objsec:=TObjSection(exesec.ObjSectionlist[j]);
  2072. if not objsec.Used then
  2073. internalerror(200603301);
  2074. objsec.FixupRelocs;
  2075. end;
  2076. end;
  2077. end;
  2078. {****************************************************************************
  2079. TObjInput
  2080. ****************************************************************************}
  2081. constructor TObjInput.create;
  2082. begin
  2083. end;
  2084. destructor TObjInput.destroy;
  2085. begin
  2086. inherited destroy;
  2087. end;
  2088. function TObjInput.newObjData(const n:string):TObjData;
  2089. begin
  2090. result:=CObjData.create(n);
  2091. end;
  2092. procedure TObjInput.inputerror(const s : string);
  2093. begin
  2094. Comment(V_Error,s+' while reading '+InputFileName);
  2095. end;
  2096. {$ifdef MEMDEBUG}
  2097. initialization
  2098. memobjsymbols:=TMemDebug.create('ObjSymbols');
  2099. memobjsymbols.stop;
  2100. memobjsections:=TMemDebug.create('ObjSections');
  2101. memobjsections.stop;
  2102. finalization
  2103. memobjsymbols.free;
  2104. memobjsections.free;
  2105. {$endif MEMDEBUG}
  2106. end.