ogbase.pas 77 KB

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