ogbase.pas 77 KB

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