ogbase.pas 77 KB

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