ogbase.pas 84 KB

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