ogbase.pas 85 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611
  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. 'fini'
  730. );
  731. var
  732. sep : string[3];
  733. begin
  734. if aname<>'' then
  735. begin
  736. case aorder of
  737. secorder_begin :
  738. sep:='.b_';
  739. secorder_end :
  740. sep:='.z_';
  741. else
  742. sep:='.n_';
  743. end;
  744. result:=secnames[atype]+sep+aname
  745. end
  746. else
  747. result:=secnames[atype];
  748. end;
  749. function TObjData.sectiontype2options(atype:TAsmSectiontype):TObjSectionOptions;
  750. const
  751. secoptions : array[TAsmSectiontype] of TObjSectionOptions = ([],
  752. {code} [oso_Data,oso_load,oso_readonly,oso_executable,oso_keep],
  753. {Data} [oso_Data,oso_load,oso_write,oso_keep],
  754. {$warning TODO Fix roData be read-only}
  755. {roData} [oso_Data,oso_load,oso_write,oso_keep],
  756. {bss} [oso_load,oso_write,oso_keep],
  757. {threadvar} [oso_load,oso_write],
  758. {pdata} [oso_load,oso_readonly,oso_keep],
  759. {stub} [oso_Data,oso_load,oso_readonly,oso_executable],
  760. {stab} [oso_Data,oso_noload,oso_debug],
  761. {stabstr} [oso_Data,oso_noload,oso_strings,oso_debug],
  762. {iData2} [oso_Data,oso_load,oso_write],
  763. {iData4} [oso_Data,oso_load,oso_write],
  764. {iData5} [oso_Data,oso_load,oso_write],
  765. {iData6} [oso_Data,oso_load,oso_write],
  766. {iData7} [oso_Data,oso_load,oso_write],
  767. {eData} [oso_Data,oso_load,oso_readonly],
  768. {eh_frame} [oso_Data,oso_load,oso_readonly],
  769. {debug_frame} [oso_Data,oso_noload,oso_debug],
  770. {debug_info} [oso_Data,oso_noload,oso_debug],
  771. {debug_line} [oso_Data,oso_noload,oso_debug],
  772. {debug_abbrev} [oso_Data,oso_noload,oso_debug],
  773. {fpc} [oso_Data,oso_load,oso_write,oso_keep],
  774. {toc} [oso_Data,oso_load,oso_readonly],
  775. {init} [oso_Data,oso_load,oso_readonly,oso_executable,oso_keep],
  776. {fini} [oso_Data,oso_load,oso_readonly,oso_executable,oso_keep]
  777. );
  778. begin
  779. result:=secoptions[atype];
  780. end;
  781. function TObjData.sectiontype2align(atype:TAsmSectiontype):shortint;
  782. begin
  783. case atype of
  784. sec_stabstr,sec_debug_info,sec_debug_line,sec_debug_abbrev:
  785. result:=1;
  786. sec_code,
  787. sec_bss,
  788. sec_data:
  789. result:=16;
  790. else
  791. result:=sizeof(aint);
  792. end;
  793. end;
  794. function TObjData.createsection(atype:TAsmSectionType;const aname:string;aorder:TAsmSectionOrder):TObjSection;
  795. begin
  796. result:=createsection(sectionname(atype,aname,aorder),sectiontype2align(atype),sectiontype2options(atype));
  797. end;
  798. function TObjData.createsection(const aname:string;aalign:shortint;aoptions:TObjSectionOptions;DiscardDuplicate:boolean):TObjSection;
  799. begin
  800. if DiscardDuplicate then
  801. result:=TObjSection(FObjSectionList.Find(aname))
  802. else
  803. result:=nil;
  804. if not assigned(result) then
  805. begin
  806. result:=CObjSection.create(FObjSectionList,aname,aalign,aoptions);
  807. result.ObjData:=self;
  808. end;
  809. FCurrObjSec:=result;
  810. end;
  811. procedure TObjData.CreateDebugSections;
  812. begin
  813. end;
  814. function TObjData.FindSection(const aname:string):TObjSection;
  815. begin
  816. result:=TObjSection(FObjSectionList.Find(aname));
  817. end;
  818. procedure TObjData.setsection(asec:TObjSection);
  819. begin
  820. if asec.ObjData<>self then
  821. internalerror(200403041);
  822. FCurrObjSec:=asec;
  823. end;
  824. function TObjData.createsymbol(const aname:string):TObjSymbol;
  825. begin
  826. result:=TObjSymbol(FObjSymbolList.Find(aname));
  827. if not assigned(result) then
  828. result:=TObjSymbol.Create(FObjSymbolList,aname);
  829. end;
  830. function TObjData.symboldefine(asmsym:TAsmSymbol):TObjSymbol;
  831. begin
  832. if assigned(asmsym) then
  833. begin
  834. if not assigned(asmsym.cachedObjSymbol) then
  835. begin
  836. result:=symboldefine(asmsym.name,asmsym.bind,asmsym.typ);
  837. asmsym.cachedObjSymbol:=result;
  838. FCachedAsmSymbolList.add(asmsym);
  839. end
  840. else
  841. begin
  842. result:=TObjSymbol(asmsym.cachedObjSymbol);
  843. result.SetAddress(CurrPass,CurrObjSec,asmsym.bind,asmsym.typ);
  844. { Register also in TObjSection }
  845. CurrObjSec.AddSymbolDefine(result);
  846. end;
  847. end
  848. else
  849. result:=nil;
  850. end;
  851. function TObjData.symboldefine(const aname:string;abind:TAsmsymbind;atyp:Tasmsymtype):TObjSymbol;
  852. begin
  853. if not assigned(CurrObjSec) then
  854. internalerror(200603051);
  855. result:=CreateSymbol(aname);
  856. { Register also in TObjSection }
  857. CurrObjSec.AddSymbolDefine(result);
  858. result.SetAddress(CurrPass,CurrObjSec,abind,atyp);
  859. end;
  860. function TObjData.symbolref(asmsym:TAsmSymbol):TObjSymbol;
  861. begin
  862. if assigned(asmsym) then
  863. begin
  864. if not assigned(asmsym.cachedObjSymbol) then
  865. begin
  866. result:=symbolref(asmsym.name);
  867. asmsym.cachedObjSymbol:=result;
  868. FCachedAsmSymbolList.add(asmsym);
  869. end
  870. else
  871. result:=TObjSymbol(asmsym.cachedObjSymbol);
  872. end
  873. else
  874. result:=nil;
  875. end;
  876. function TObjData.symbolref(const aname:string):TObjSymbol;
  877. begin
  878. if not assigned(CurrObjSec) then
  879. internalerror(200603052);
  880. result:=CreateSymbol(aname);
  881. end;
  882. procedure TObjData.ResetCachedAsmSymbols;
  883. var
  884. i : longint;
  885. begin
  886. for i:=0 to FCachedAsmSymbolList.Count-1 do
  887. tasmsymbol(FCachedAsmSymbolList[i]).cachedObjSymbol:=nil;
  888. FCachedAsmSymbolList.Clear;
  889. end;
  890. procedure TObjData.writebytes(const Data;len:aint);
  891. begin
  892. if not assigned(CurrObjSec) then
  893. internalerror(200402251);
  894. CurrObjSec.write(Data,len);
  895. end;
  896. procedure TObjData.alloc(len:aint);
  897. begin
  898. if not assigned(CurrObjSec) then
  899. internalerror(200402252);
  900. CurrObjSec.alloc(len);
  901. end;
  902. procedure TObjData.allocalign(len:shortint);
  903. begin
  904. if not assigned(CurrObjSec) then
  905. internalerror(200402253);
  906. CurrObjSec.alloc(align(CurrObjSec.size,len)-CurrObjSec.size);
  907. end;
  908. procedure TObjData.section_afteralloc(p:TObject;arg:pointer);
  909. begin
  910. with TObjSection(p) do
  911. alloc(align(size,secalign)-size);
  912. end;
  913. procedure TObjData.section_afterwrite(p:TObject;arg:pointer);
  914. begin
  915. with TObjSection(p) do
  916. begin
  917. if assigned(Data) then
  918. writezeros(align(size,secalign)-size);
  919. end;
  920. end;
  921. procedure TObjData.section_reset(p:TObject;arg:pointer);
  922. begin
  923. with TObjSection(p) do
  924. begin
  925. Size:=0;
  926. Datapos:=0;
  927. mempos:=0;
  928. end;
  929. end;
  930. procedure TObjData.beforealloc;
  931. begin
  932. { create stabs sections if debugging }
  933. if assigned(StabsSec) then
  934. begin
  935. StabsSec.Alloc(sizeof(TObjStabEntry));
  936. StabStrSec.Alloc(1);
  937. end;
  938. end;
  939. procedure TObjData.beforewrite;
  940. var
  941. s : string[1];
  942. hstab : TObjStabEntry;
  943. begin
  944. { create stabs sections if debugging }
  945. if assigned(StabsSec) then
  946. begin
  947. { Create dummy HdrSym stab, it will be overwritten in AfterWrite }
  948. fillchar(hstab,sizeof(hstab),0);
  949. StabsSec.Write(hstab,sizeof(hstab));
  950. { start of stabstr }
  951. s:=#0;
  952. StabStrSec.write(s[1],length(s));
  953. end;
  954. end;
  955. procedure TObjData.afteralloc;
  956. begin
  957. FObjSectionList.ForEachCall(@section_afteralloc,nil);
  958. end;
  959. procedure TObjData.afterwrite;
  960. var
  961. s : string[1];
  962. hstab : TObjStabEntry;
  963. begin
  964. FObjSectionList.ForEachCall(@section_afterwrite,nil);
  965. { For the stab section we need an HdrSym which can now be
  966. calculated more easily }
  967. if assigned(StabsSec) then
  968. begin
  969. { end of stabstr }
  970. s:=#0;
  971. StabStrSec.write(s[1],length(s));
  972. { header stab }
  973. hstab.strpos:=1;
  974. hstab.ntype:=0;
  975. hstab.nother:=0;
  976. hstab.ndesc:=(StabsSec.Size div sizeof(TObjStabEntry))-1;
  977. hstab.nvalue:=StabStrSec.Size;
  978. StabsSec.Data.seek(0);
  979. StabsSec.Data.write(hstab,sizeof(hstab));
  980. end;
  981. end;
  982. procedure TObjData.resetsections;
  983. begin
  984. FObjSectionList.ForEachCall(@section_reset,nil);
  985. end;
  986. {****************************************************************************
  987. TObjOutput
  988. ****************************************************************************}
  989. constructor TObjOutput.create(AWriter:TObjectWriter);
  990. begin
  991. FWriter:=AWriter;
  992. CObjData:=TObjData;
  993. end;
  994. destructor TObjOutput.destroy;
  995. begin
  996. inherited destroy;
  997. end;
  998. function TObjOutput.newObjData(const n:string):TObjData;
  999. begin
  1000. result:=CObjData.create(n);
  1001. if (cs_use_lineinfo in current_settings.globalswitches) or
  1002. (cs_debuginfo in current_settings.moduleswitches) then
  1003. result.CreateDebugSections;
  1004. end;
  1005. function TObjOutput.startObjectfile(const fn:string):boolean;
  1006. begin
  1007. result:=false;
  1008. { start the writer already, so the .a generation can initialize
  1009. the position of the current objectfile }
  1010. if not FWriter.createfile(fn) then
  1011. Comment(V_Fatal,'Can''t create object '+fn);
  1012. result:=true;
  1013. end;
  1014. function TObjOutput.writeobjectfile(Data:TObjData):boolean;
  1015. begin
  1016. if errorcount=0 then
  1017. result:=writeData(Data)
  1018. else
  1019. result:=true;
  1020. { close the writer }
  1021. FWriter.closefile;
  1022. end;
  1023. procedure TObjOutput.exportsymbol(p:TObjSymbol);
  1024. begin
  1025. { export globals and common symbols, this is needed
  1026. for .a files }
  1027. if p.bind in [AB_GLOBAL,AB_COMMON] then
  1028. FWriter.writesym(p.name);
  1029. end;
  1030. {****************************************************************************
  1031. TExeVTable
  1032. ****************************************************************************}
  1033. constructor TExeVTable.Create(AExeSymbol:TExeSymbol);
  1034. begin
  1035. ExeSymbol:=AExeSymbol;
  1036. if ExeSymbol.State=symstate_undefined then
  1037. internalerror(200604012);
  1038. ChildList:=TFPObjectList.Create(false);
  1039. end;
  1040. destructor TExeVTable.Destroy;
  1041. begin
  1042. ChildList.Free;
  1043. if assigned(EntryArray) then
  1044. Freemem(EntryArray);
  1045. end;
  1046. procedure TExeVTable.CheckIdx(VTableIdx:longint);
  1047. var
  1048. OldEntryCnt : longint;
  1049. begin
  1050. if VTableIdx>=EntryCnt then
  1051. begin
  1052. OldEntryCnt:=EntryCnt;
  1053. EntryCnt:=VTableIdx+1;
  1054. ReAllocMem(EntryArray,EntryCnt*sizeof(TVTableEntry));
  1055. FillChar(EntryArray[OldEntryCnt],(EntryCnt-OldEntryCnt)*sizeof(TVTableEntry),0);
  1056. end;
  1057. end;
  1058. procedure TExeVTable.AddChild(vt:TExeVTable);
  1059. begin
  1060. ChildList.Add(vt);
  1061. end;
  1062. procedure TExeVTable.AddEntry(VTableIdx:Longint);
  1063. var
  1064. i : longint;
  1065. objreloc : TObjRelocation;
  1066. vtblentryoffset : aint;
  1067. begin
  1068. CheckIdx(VTableIdx);
  1069. vtblentryoffset:=ExeSymbol.ObjSymbol.Offset+VTableIdx*sizeof(aint);
  1070. { Find and disable relocation }
  1071. for i:=0 to ExeSymbol.ObjSymbol.ObjSection.ObjRelocations.Count-1 do
  1072. begin
  1073. objreloc:=TObjRelocation(ExeSymbol.ObjSymbol.ObjSection.ObjRelocations[i]);
  1074. if objreloc.dataoffset=vtblentryoffset then
  1075. begin
  1076. EntryArray[VTableIdx].ObjRelocation:=objreloc;
  1077. EntryArray[VTableIdx].OrgRelocType:=objreloc.typ;
  1078. objreloc.typ:=RELOC_ZERO;
  1079. break;
  1080. end;
  1081. end;
  1082. if not assigned(EntryArray[VTableIdx].ObjRelocation) then
  1083. internalerror(200604011);
  1084. end;
  1085. procedure TExeVTable.SetVTableSize(ASize:longint);
  1086. begin
  1087. if EntryCnt<>0 then
  1088. internalerror(200603313);
  1089. EntryCnt:=ASize div sizeof(aint);
  1090. EntryArray:=AllocMem(EntryCnt*sizeof(TVTableEntry));
  1091. end;
  1092. function TExeVTable.VTableRef(VTableIdx:Longint):TObjRelocation;
  1093. begin
  1094. result:=nil;
  1095. CheckIdx(VTableIdx);
  1096. if EntryArray[VTableIdx].Used then
  1097. exit;
  1098. { Restore relocation if available }
  1099. if assigned(EntryArray[VTableIdx].ObjRelocation) then
  1100. begin
  1101. EntryArray[VTableIdx].ObjRelocation.typ:=EntryArray[VTableIdx].OrgRelocType;
  1102. result:=EntryArray[VTableIdx].ObjRelocation;
  1103. end;
  1104. EntryArray[VTableIdx].Used:=true;
  1105. end;
  1106. {****************************************************************************
  1107. TExeSection
  1108. ****************************************************************************}
  1109. constructor TExeSection.create(AList:TFPHashObjectList;const AName:string);
  1110. begin
  1111. inherited create(AList,AName);
  1112. Size:=0;
  1113. MemPos:=0;
  1114. DataPos:=0;
  1115. FSecSymIdx:=0;
  1116. FObjSectionList:=TFPObjectList.Create(false);
  1117. end;
  1118. destructor TExeSection.destroy;
  1119. begin
  1120. ObjSectionList.Free;
  1121. inherited destroy;
  1122. end;
  1123. procedure TExeSection.AddObjSection(objsec:TObjSection);
  1124. begin
  1125. ObjSectionList.Add(objsec);
  1126. if (SecOptions<>[]) then
  1127. begin
  1128. { Only if the section contains (un)initialized data the
  1129. data flag must match. This check is not needed if the
  1130. section is empty for a symbol allocation }
  1131. if (objsec.size>0) and
  1132. ((oso_Data in SecOptions)<>(oso_Data in objsec.SecOptions)) then
  1133. Comment(V_Error,'Incompatible section options');
  1134. end
  1135. else
  1136. begin
  1137. { inherit section options }
  1138. SecAlign:=objsec.SecAlign;
  1139. SecOptions:=SecOptions+objsec.SecOptions;
  1140. end;
  1141. { relate ObjSection to ExeSection, and mark it Used by default }
  1142. objsec.ExeSection:=self;
  1143. objsec.Used:=true;
  1144. end;
  1145. {****************************************************************************
  1146. TStaticLibrary
  1147. ****************************************************************************}
  1148. constructor TStaticLibrary.create(AList:TFPHashObjectList;const AName:string;AReader:TObjectReader;AObjInputClass:TObjInputClass);
  1149. begin
  1150. inherited create(AList,AName);
  1151. FArReader:=AReader;
  1152. FObjInputClass:=AObjInputClass;
  1153. end;
  1154. destructor TStaticLibrary.destroy;
  1155. begin
  1156. ArReader.Free;
  1157. inherited destroy;
  1158. end;
  1159. {****************************************************************************
  1160. TImportLibrary
  1161. ****************************************************************************}
  1162. constructor TImportLibrary.create(AList:TFPHashObjectList;const AName:string);
  1163. begin
  1164. inherited create(AList,AName);
  1165. FImportSymbolList:=TFPHashObjectList.Create(true);
  1166. end;
  1167. destructor TImportLibrary.destroy;
  1168. begin
  1169. ImportSymbolList.Free;
  1170. inherited destroy;
  1171. end;
  1172. {****************************************************************************
  1173. TImportSymbol
  1174. ****************************************************************************}
  1175. constructor TImportSymbol.create(AList:TFPHashObjectList;const AName:string;AOrdNr:longint;AIsVar:boolean);
  1176. begin
  1177. inherited Create(AList, AName);
  1178. FOrdNr:=AOrdNr;
  1179. FIsVar:=AIsVar;
  1180. FMangledName:=AName;
  1181. { Replace ? and @ in import name }
  1182. Replace(FMangledName,'?','__q$$');
  1183. Replace(FMangledName,'@','__a$$');
  1184. end;
  1185. {****************************************************************************
  1186. TExeOutput
  1187. ****************************************************************************}
  1188. constructor TExeOutput.create;
  1189. begin
  1190. { init writer }
  1191. FWriter:=TObjectwriter.create;
  1192. { object files }
  1193. FObjDataList:=TFPObjectList.Create(true);
  1194. { symbols }
  1195. FExeSymbolList:=TFPHashObjectList.Create(true);
  1196. FUnresolvedExeSymbols:=TFPObjectList.Create(false);
  1197. FExternalObjSymbols:=TFPObjectList.Create(false);
  1198. FCommonObjSymbols:=TFPObjectList.Create(false);
  1199. FExeVTableList:=TFPObjectList.Create(false);
  1200. FEntryName:='start';
  1201. { sections }
  1202. FExeSectionList:=TFPHashObjectList.Create(true);
  1203. FDebugSectionList:=TFPHashObjectList.Create(true);
  1204. FImageBase:=0;
  1205. SectionMemAlign:=$1000;
  1206. SectionDataAlign:=$200;
  1207. FCExeSection:=TExeSection;
  1208. FCObjData:=TObjData;
  1209. end;
  1210. destructor TExeOutput.destroy;
  1211. begin
  1212. FExeSymbolList.free;
  1213. UnresolvedExeSymbols.free;
  1214. ExternalObjSymbols.free;
  1215. CommonObjSymbols.free;
  1216. ExeVTableList.free;
  1217. FExeSectionList.free;
  1218. FDebugSectionList.free;
  1219. ObjDatalist.free;
  1220. FWriter.free;
  1221. inherited destroy;
  1222. end;
  1223. function TExeOutput.writedbgfile(const fn:string):boolean;
  1224. var
  1225. ObjWriter : TObjectwriter;
  1226. exesec : TExeSection;
  1227. objsec : TObjSection;
  1228. header : string[6];
  1229. s : string;
  1230. i,j,
  1231. seccnt,
  1232. secstart : longint;
  1233. begin
  1234. result:=false;
  1235. {
  1236. File layout:
  1237. <header> 6 bytes
  1238. <section count> 4 bytes
  1239. (
  1240. <section offset> 4 bytes
  1241. <section name> asciiz
  1242. ...
  1243. )
  1244. (
  1245. <section data>
  1246. ...
  1247. )
  1248. }
  1249. header:='FPCDBG';
  1250. { Calculate file offsets }
  1251. secstart:=length(header)+sizeof(seccnt);
  1252. for i:=0 to DebugSectionList.Count-1 do
  1253. begin
  1254. exesec:=TExeSection(DebugSectionList[i]);
  1255. inc(secstart,sizeof(secstart)+length(exesec.Name)+1);
  1256. end;
  1257. for i:=0 to DebugSectionList.Count-1 do
  1258. begin
  1259. exesec:=TExeSection(DebugSectionList[i]);
  1260. exesec.DataPos:=secstart;
  1261. for j:=0 to exesec.ObjSectionList.Count-1 do
  1262. begin
  1263. objsec:=TObjSection(exesec.ObjSectionList[j]);
  1264. inc(secstart,objsec.size);
  1265. end;
  1266. end;
  1267. { Create file }
  1268. ObjWriter:=TObjectwriter.Create;
  1269. if not ObjWriter.createfile(fn) then
  1270. begin
  1271. ObjWriter.Free;
  1272. exit;
  1273. end;
  1274. { Header }
  1275. ObjWriter.Write(header[1], Length(header));
  1276. seccnt:=DebugSectionList.Count;
  1277. ObjWriter.Write(seccnt,sizeof(seccnt));
  1278. for i:=0 to DebugSectionList.Count-1 do
  1279. begin
  1280. exesec:=TExeSection(DebugSectionList[i]);
  1281. ObjWriter.Write(exesec.DataPos,sizeof(secstart));
  1282. s:=exesec.Name;
  1283. ObjWriter.Write(s[1],length(s));
  1284. ObjWriter.writezeros(1);
  1285. end;
  1286. { Write section data }
  1287. for i:=0 to DebugSectionList.Count-1 do
  1288. begin
  1289. exesec:=TExeSection(DebugSectionList[i]);
  1290. if exesec.DataPos<>ObjWriter.ObjSize then
  1291. internalerror(200702241);
  1292. for j:=0 to exesec.ObjSectionList.Count-1 do
  1293. begin
  1294. objsec:=TObjSection(exesec.ObjSectionList[j]);
  1295. ObjWriter.writearray(objsec.data);
  1296. end;
  1297. end;
  1298. ObjWriter.Free;
  1299. result:=true;
  1300. end;
  1301. function TExeOutput.writeexefile(const fn:string):boolean;
  1302. begin
  1303. result:=false;
  1304. if FWriter.createfile(fn) then
  1305. begin
  1306. { Only write the .o if there are no errors }
  1307. if errorcount=0 then
  1308. result:=writeData
  1309. else
  1310. result:=true;
  1311. { close the writer }
  1312. FWriter.closefile;
  1313. end
  1314. else
  1315. Comment(V_Fatal,'Can''t create executable '+fn);
  1316. end;
  1317. function TExeOutput.FindExeSection(const aname:string):TExeSection;
  1318. begin
  1319. result:=TExeSection(ExeSectionList.Find(aname));
  1320. end;
  1321. procedure TExeOutput.AddObjData(ObjData:TObjData);
  1322. begin
  1323. if ObjData.classtype<>FCObjData then
  1324. Comment(V_Error,'Invalid input object format for '+ObjData.name+' got '+ObjData.classname+' expected '+FCObjData.classname);
  1325. ObjDataList.Add(ObjData);
  1326. end;
  1327. procedure TExeOutput.Load_Start;
  1328. begin
  1329. ObjDataList.Clear;
  1330. { Globals defined in the linker script }
  1331. if not assigned(internalObjData) then
  1332. internalObjData:=CObjData.create('*Internal*');
  1333. AddObjData(internalObjData);
  1334. { Common Data section }
  1335. commonObjSection:=internalObjData.createsection(sec_bss,'');
  1336. end;
  1337. procedure TExeOutput.Load_EntryName(const aname:string);
  1338. begin
  1339. EntryName:=aname;
  1340. end;
  1341. procedure TExeOutput.Load_IsSharedLibrary;
  1342. begin
  1343. IsSharedLibrary:=true;
  1344. end;
  1345. procedure TExeOutput.Load_ImageBase(const avalue:string);
  1346. var
  1347. code : integer;
  1348. objsec : TObjSection;
  1349. objsym : TObjSymbol;
  1350. exesym : TExeSymbol;
  1351. begin
  1352. val(avalue,ImageBase,code);
  1353. if code<>0 then
  1354. Comment(V_Error,'Invalid number '+avalue);
  1355. { Create __image_base__ symbol, create the symbol
  1356. in a section with adress 0 and at offset 0 }
  1357. objsec:=internalObjData.createsection('*__image_base__',0,[]);
  1358. internalObjData.setsection(objsec);
  1359. objsym:=internalObjData.SymbolDefine('__image_base__',AB_GLOBAL,AT_FUNCTION);
  1360. exesym:=texesymbol.Create(FExeSymbolList,objsym.name);
  1361. exesym.ObjSymbol:=objsym;
  1362. end;
  1363. procedure TExeOutput.Load_Symbol(const aname:string);
  1364. begin
  1365. internalObjData.createsection('*'+aname,0,[]);
  1366. internalObjData.SymbolDefine(aname,AB_GLOBAL,AT_FUNCTION);
  1367. end;
  1368. procedure TExeOutput.Order_Start;
  1369. begin
  1370. end;
  1371. procedure TExeOutput.Order_End;
  1372. begin
  1373. internalObjData.afterwrite;
  1374. end;
  1375. procedure TExeOutput.Order_ExeSection(const aname:string);
  1376. var
  1377. sec : TExeSection;
  1378. begin
  1379. sec:=FindExeSection(aname);
  1380. if not assigned(sec) then
  1381. sec:=CExeSection.create(ExeSectionList,aname);
  1382. { Clear ExeSection contents }
  1383. FCurrExeSec:=sec;
  1384. end;
  1385. procedure TExeOutput.Order_EndExeSection;
  1386. begin
  1387. if not assigned(CurrExeSec) then
  1388. internalerror(200602184);
  1389. FCurrExeSec:=nil;
  1390. end;
  1391. procedure TExeOutput.Order_ObjSection(const aname:string);
  1392. var
  1393. i,j : longint;
  1394. ObjData : TObjData;
  1395. objsec : TObjSection;
  1396. TmpObjSectionList : TFPObjectList;
  1397. begin
  1398. if not assigned(CurrExeSec) then
  1399. internalerror(200602181);
  1400. TmpObjSectionList:=TFPObjectList.Create(false);
  1401. for i:=0 to ObjDataList.Count-1 do
  1402. begin
  1403. ObjData:=TObjData(ObjDataList[i]);
  1404. for j:=0 to ObjData.ObjSectionList.Count-1 do
  1405. begin
  1406. objsec:=TObjSection(ObjData.ObjSectionList[j]);
  1407. if (not objsec.Used) and
  1408. MatchPattern(aname,objsec.name) then
  1409. TmpObjSectionList.Add(objsec);
  1410. end;
  1411. end;
  1412. { Order list if needed }
  1413. Order_ObjSectionList(TmpObjSectionList);
  1414. { Add the (ordered) list to the current ExeSection }
  1415. for i:=0 to TmpObjSectionList.Count-1 do
  1416. begin
  1417. objsec:=TObjSection(TmpObjSectionList[i]);
  1418. CurrExeSec.AddObjSection(objsec);
  1419. end;
  1420. TmpObjSectionList.Free;
  1421. end;
  1422. procedure TExeOutput.Order_ObjSectionList(ObjSectionList : TFPObjectList);
  1423. begin
  1424. end;
  1425. procedure TExeOutput.Order_Symbol(const aname:string);
  1426. var
  1427. ObjSection : TObjSection;
  1428. begin
  1429. ObjSection:=internalObjData.findsection('*'+aname);
  1430. if not assigned(ObjSection) then
  1431. internalerror(200603041);
  1432. CurrExeSec.AddObjSection(ObjSection);
  1433. end;
  1434. procedure TExeOutput.Order_Align(const avalue:string);
  1435. var
  1436. code : integer;
  1437. alignval : shortint;
  1438. objsec : TObjSection;
  1439. begin
  1440. val(avalue,alignval,code);
  1441. if code<>0 then
  1442. Comment(V_Error,'Invalid number '+avalue);
  1443. if alignval<=0 then
  1444. exit;
  1445. { Create an empty section with the required aligning }
  1446. inc(Fzeronr);
  1447. objsec:=internalObjData.createsection('*align'+tostr(Fzeronr),alignval,CurrExeSec.SecOptions+[oso_Data,oso_keep]);
  1448. CurrExeSec.AddObjSection(objsec);
  1449. end;
  1450. procedure TExeOutput.Order_Zeros(const avalue:string);
  1451. var
  1452. zeros : array[0..1023] of byte;
  1453. code : integer;
  1454. len : longint;
  1455. objsec : TObjSection;
  1456. begin
  1457. val(avalue,len,code);
  1458. if code<>0 then
  1459. Comment(V_Error,'Invalid number '+avalue);
  1460. if len<=0 then
  1461. exit;
  1462. if len>sizeof(zeros) then
  1463. internalerror(200602254);
  1464. fillchar(zeros,len,0);
  1465. inc(Fzeronr);
  1466. objsec:=internalObjData.createsection('*zeros'+tostr(Fzeronr),0,CurrExeSec.SecOptions+[oso_Data,oso_keep]);
  1467. internalObjData.writebytes(zeros,len);
  1468. CurrExeSec.AddObjSection(objsec);
  1469. end;
  1470. procedure TExeOutput.CalcPos_ExeSection(const aname:string);
  1471. var
  1472. i : longint;
  1473. objsec : TObjSection;
  1474. begin
  1475. { Section can be removed }
  1476. FCurrExeSec:=FindExeSection(aname);
  1477. if not assigned(CurrExeSec) then
  1478. exit;
  1479. { Alignment of ExeSection }
  1480. CurrMemPos:=align(CurrMemPos,SectionMemAlign);
  1481. CurrExeSec.MemPos:=CurrMemPos;
  1482. if (oso_Data in currexesec.SecOptions) then
  1483. begin
  1484. CurrDataPos:=align(CurrDataPos,SectionDataAlign);
  1485. CurrExeSec.DataPos:=CurrDataPos;
  1486. end;
  1487. { set position of object ObjSections }
  1488. for i:=0 to CurrExeSec.ObjSectionList.Count-1 do
  1489. begin
  1490. objsec:=TObjSection(CurrExeSec.ObjSectionList[i]);
  1491. { Position in memory }
  1492. objsec.setmempos(CurrMemPos);
  1493. { Position in File }
  1494. if (oso_Data in objsec.SecOptions) then
  1495. begin
  1496. if not (oso_Data in currexesec.SecOptions) then
  1497. internalerror(200603043);
  1498. if not assigned(objsec.Data) then
  1499. internalerror(200603044);
  1500. objsec.setDatapos(CurrDataPos);
  1501. end;
  1502. end;
  1503. { calculate size of the section }
  1504. CurrExeSec.Size:=CurrMemPos-CurrExeSec.MemPos;
  1505. end;
  1506. procedure TExeOutput.CalcPos_EndExeSection;
  1507. begin
  1508. if not assigned(CurrExeSec) then
  1509. exit;
  1510. FCurrExeSec:=nil;
  1511. end;
  1512. procedure TExeOutput.CalcPos_Start;
  1513. begin
  1514. CurrMemPos:=0;
  1515. CurrDataPos:=0;
  1516. end;
  1517. procedure TExeOutput.CalcPos_Header;
  1518. begin
  1519. end;
  1520. procedure TExeOutput.CalcPos_Symbols;
  1521. var
  1522. i : longint;
  1523. sym : TExeSymbol;
  1524. begin
  1525. { Removing unused symbols }
  1526. for i:=0 to ExeSymbolList.Count-1 do
  1527. begin
  1528. sym:=TExeSymbol(ExeSymbolList[i]);
  1529. if not sym.ObjSymbol.objsection.Used then
  1530. ExeSymbolList[i]:=nil;
  1531. end;
  1532. ExeSymbolList.Pack;
  1533. end;
  1534. procedure TExeOutput.BuildVTableTree(VTInheritList,VTEntryList:TFPObjectList);
  1535. var
  1536. hs : string;
  1537. code : integer;
  1538. i,k,
  1539. vtableidx : longint;
  1540. vtableexesym,
  1541. childexesym,
  1542. parentexesym : TExeSymbol;
  1543. objsym : TObjSymbol;
  1544. begin
  1545. { Build inheritance tree from VTINHERIT }
  1546. for i:=0 to VTInheritList.Count-1 do
  1547. begin
  1548. objsym:=TObjSymbol(VTInheritList[i]);
  1549. hs:=objsym.name;
  1550. { VTINHERIT_<ChildVMTName>$$<ParentVMTName> }
  1551. Delete(hs,1,Pos('_',hs));
  1552. k:=Pos('$$',hs);
  1553. if k=0 then
  1554. internalerror(200603311);
  1555. childexesym:=texesymbol(FExeSymbolList.Find(Copy(hs,1,k-1)));
  1556. parentexesym:=texesymbol(FExeSymbolList.Find(Copy(hs,k+2,length(hs)-k-1)));
  1557. if not assigned(childexesym) or
  1558. not assigned(parentexesym)then
  1559. internalerror(200603312);
  1560. if not assigned(childexesym.vtable) then
  1561. begin
  1562. childexesym.vtable:=TExeVTable.Create(childexesym);
  1563. ExeVTableList.Add(childexesym.vtable);
  1564. end;
  1565. if not assigned(parentexesym.vtable) then
  1566. begin
  1567. parentexesym.vtable:=TExeVTable.Create(parentexesym);
  1568. ExeVTableList.Add(parentexesym.vtable);
  1569. end;
  1570. childexesym.vtable.SetVTableSize(childexesym.ObjSymbol.Size);
  1571. if parentexesym<>childexesym then
  1572. parentexesym.vtable.AddChild(childexesym.vtable);
  1573. end;
  1574. { Find VTable entries from VTENTRY }
  1575. for i:=0 to VTEntryList.Count-1 do
  1576. begin
  1577. objsym:=TObjSymbol(VTEntryList[i]);
  1578. hs:=objsym.name;
  1579. { VTENTRY_<VTableName>$$<Index> }
  1580. Delete(hs,1,Pos('_',hs));
  1581. k:=Pos('$$',hs);
  1582. if k=0 then
  1583. internalerror(200603319);
  1584. vtableexesym:=texesymbol(FExeSymbolList.Find(Copy(hs,1,k-1)));
  1585. val(Copy(hs,k+2,length(hs)-k-1),vtableidx,code);
  1586. if (code<>0) then
  1587. internalerror(200603318);
  1588. if not assigned(vtableexesym) then
  1589. internalerror(2006033110);
  1590. vtableexesym.vtable.AddEntry(vtableidx);
  1591. end;
  1592. end;
  1593. procedure TExeOutput.PackUnresolvedExeSymbols(const s:string);
  1594. var
  1595. i : longint;
  1596. exesym : TExeSymbol;
  1597. begin
  1598. { Generate a list of Unresolved External symbols }
  1599. for i:=0 to UnresolvedExeSymbols.count-1 do
  1600. begin
  1601. exesym:=TExeSymbol(UnresolvedExeSymbols[i]);
  1602. if exesym.State<>symstate_undefined then
  1603. UnresolvedExeSymbols[i]:=nil;
  1604. end;
  1605. UnresolvedExeSymbols.Pack;
  1606. Comment(V_Debug,'Number of unresolved externals '+s+' '+tostr(UnresolvedExeSymbols.Count));
  1607. end;
  1608. procedure TExeOutput.ResolveSymbols(StaticLibraryList:TFPHashObjectList);
  1609. var
  1610. ObjData : TObjData;
  1611. exesym : TExeSymbol;
  1612. objsym,
  1613. commonsym : TObjSymbol;
  1614. objinput : TObjInput;
  1615. StaticLibrary : TStaticLibrary;
  1616. firstarchive,
  1617. firstcommon : boolean;
  1618. i,j : longint;
  1619. VTEntryList,
  1620. VTInheritList : TFPObjectList;
  1621. procedure LoadObjDataSymbols(ObjData:TObjData);
  1622. var
  1623. j : longint;
  1624. hs : string;
  1625. exesym : TExeSymbol;
  1626. objsym : TObjSymbol;
  1627. begin
  1628. for j:=0 to ObjData.ObjSymbolList.Count-1 do
  1629. begin
  1630. objsym:=TObjSymbol(ObjData.ObjSymbolList[j]);
  1631. { From the local symbols we are only interressed in the
  1632. VTENTRY and VTINHERIT symbols }
  1633. if objsym.bind=AB_LOCAL then
  1634. begin
  1635. if cs_link_opt_vtable in current_settings.globalswitches then
  1636. begin
  1637. hs:=objsym.name;
  1638. if (hs[1]='V') then
  1639. begin
  1640. if Copy(hs,1,5)='VTREF' then
  1641. begin
  1642. if not assigned(objsym.ObjSection.VTRefList) then
  1643. objsym.ObjSection.VTRefList:=TFPObjectList.Create(false);
  1644. objsym.ObjSection.VTRefList.Add(objsym);
  1645. end
  1646. else if Copy(hs,1,7)='VTENTRY' then
  1647. VTEntryList.Add(objsym)
  1648. else if Copy(hs,1,9)='VTINHERIT' then
  1649. VTInheritList.Add(objsym);
  1650. end;
  1651. end;
  1652. continue;
  1653. end;
  1654. { Search for existing exesymbol }
  1655. exesym:=texesymbol(FExeSymbolList.Find(objsym.name));
  1656. if not assigned(exesym) then
  1657. begin
  1658. exesym:=texesymbol.Create(FExeSymbolList,objsym.name);
  1659. exesym.ObjSymbol:=objsym;
  1660. end;
  1661. objsym.ExeSymbol:=exesym;
  1662. case objsym.bind of
  1663. AB_GLOBAL :
  1664. begin
  1665. if exesym.State<>symstate_defined then
  1666. begin
  1667. exesym.ObjSymbol:=objsym;
  1668. exesym.State:=symstate_defined;
  1669. end
  1670. else
  1671. Comment(V_Error,'Multiple defined symbol '+objsym.name);
  1672. end;
  1673. AB_EXTERNAL :
  1674. begin
  1675. ExternalObjSymbols.add(objsym);
  1676. { Register unresolved symbols only the first time they
  1677. are registered }
  1678. if exesym.ObjSymbol=objsym then
  1679. UnresolvedExeSymbols.Add(exesym);
  1680. end;
  1681. AB_COMMON :
  1682. begin
  1683. if exesym.State=symstate_undefined then
  1684. begin
  1685. exesym.ObjSymbol:=objsym;
  1686. exesym.State:=symstate_common;
  1687. end;
  1688. CommonObjSymbols.add(objsym);
  1689. end;
  1690. end;
  1691. end;
  1692. end;
  1693. begin
  1694. VTEntryList:=TFPObjectList.Create(false);
  1695. VTInheritList:=TFPObjectList.Create(false);
  1696. {
  1697. The symbol resolving is done in 3 steps:
  1698. 1. Register symbols from objects
  1699. 2. Find symbols in static libraries
  1700. 3. Define stil undefined common symbols
  1701. }
  1702. { Step 1, Register symbols from objects }
  1703. for i:=0 to ObjDataList.Count-1 do
  1704. begin
  1705. ObjData:=TObjData(ObjDataList[i]);
  1706. LoadObjDataSymbols(ObjData);
  1707. end;
  1708. PackUnresolvedExeSymbols('in objects');
  1709. { Step 2, Find unresolved symbols in the libraries }
  1710. firstarchive:=true;
  1711. for i:=0 to StaticLibraryList.Count-1 do
  1712. begin
  1713. StaticLibrary:=TStaticLibrary(StaticLibraryList[i]);
  1714. { Process list of Unresolved External symbols, we need
  1715. to use a while loop because the list can be extended when
  1716. we load members from the library. }
  1717. j:=0;
  1718. while (j<UnresolvedExeSymbols.count) do
  1719. begin
  1720. exesym:=TExeSymbol(UnresolvedExeSymbols[j]);
  1721. { Check first if the symbol is still undefined }
  1722. if exesym.State=symstate_undefined then
  1723. begin
  1724. if StaticLibrary.ArReader.OpenFile(exesym.name) then
  1725. begin
  1726. if assigned(exemap) then
  1727. begin
  1728. if firstarchive then
  1729. begin
  1730. exemap.Add('');
  1731. exemap.Add('Archive member included because of file (symbol)');
  1732. exemap.Add('');
  1733. firstarchive:=false;
  1734. end;
  1735. exemap.Add(StaticLibrary.ArReader.FileName+' - '+
  1736. {exesym.ObjSymbol.ObjSection.FullName+}
  1737. '('+exesym.Name+')');
  1738. end;
  1739. objinput:=StaticLibrary.ObjInputClass.Create;
  1740. objdata:=objinput.newObjData(StaticLibrary.ArReader.FileName);
  1741. objinput.ReadObjData(StaticLibrary.ArReader,objdata);
  1742. objinput.free;
  1743. AddObjData(objdata);
  1744. LoadObjDataSymbols(objdata);
  1745. StaticLibrary.ArReader.CloseFile;
  1746. end;
  1747. end;
  1748. inc(j);
  1749. end;
  1750. end;
  1751. PackUnresolvedExeSymbols('after static libraries');
  1752. { Step 3, Match common symbols or add to the globals }
  1753. firstcommon:=true;
  1754. for i:=0 to CommonObjSymbols.count-1 do
  1755. begin
  1756. objsym:=TObjSymbol(CommonObjSymbols[i]);
  1757. if objsym.exesymbol.State=symstate_defined then
  1758. begin
  1759. if objsym.exesymbol.ObjSymbol.size<>objsym.size then
  1760. Comment(V_Debug,'Size of common symbol '+objsym.name+' is different, expected '+tostr(objsym.size)+' got '+tostr(objsym.exesymbol.ObjSymbol.size));
  1761. end
  1762. else
  1763. begin
  1764. { allocate new objsymbol in .bss of *COMMON* and assign
  1765. it to the exesymbol }
  1766. if firstcommon then
  1767. begin
  1768. if assigned(exemap) then
  1769. exemap.AddCommonSymbolsHeader;
  1770. firstcommon:=false;
  1771. end;
  1772. internalObjData.setsection(commonObjSection);
  1773. internalObjData.allocalign(var_align(objsym.size));
  1774. commonsym:=internalObjData.symboldefine(objsym.name,AB_GLOBAL,AT_FUNCTION);
  1775. commonsym.size:=objsym.size;
  1776. internalObjData.alloc(objsym.size);
  1777. if assigned(exemap) then
  1778. exemap.AddCommonSymbol(commonsym);
  1779. { Assign to the exesymbol }
  1780. objsym.exesymbol.objsymbol:=commonsym;
  1781. objsym.exesymbol.state:=symstate_defined;
  1782. end;
  1783. end;
  1784. PackUnresolvedExeSymbols('after defining COMMON symbols');
  1785. { Find entry symbol and print in map }
  1786. exesym:=texesymbol(ExeSymbolList.Find(EntryName));
  1787. if assigned(exesym) then
  1788. begin
  1789. EntrySym:=exesym.ObjSymbol;
  1790. if assigned(exemap) then
  1791. begin
  1792. exemap.Add('');
  1793. exemap.Add('Entry symbol '+EntryName);
  1794. end;
  1795. end
  1796. else
  1797. Comment(V_Error,'Entrypoint '+EntryName+' not defined');
  1798. { Generate VTable tree }
  1799. if cs_link_opt_vtable in current_settings.globalswitches then
  1800. BuildVTableTree(VTInheritList,VTEntryList);
  1801. VTInheritList.Free;
  1802. VTEntryList.Free;
  1803. end;
  1804. procedure TExeOutput.GenerateLibraryImports(ImportLibraryList:TFPHashObjectList);
  1805. begin
  1806. end;
  1807. procedure TExeOutput.PrintMemoryMap;
  1808. var
  1809. exesec : TExeSection;
  1810. objsec : TObjSection;
  1811. objsym : TObjSymbol;
  1812. i,j,k : longint;
  1813. begin
  1814. if not assigned(exemap) then
  1815. exit;
  1816. exemap.AddMemoryMapHeader(ImageBase);
  1817. for i:=0 to ExeSectionList.Count-1 do
  1818. begin
  1819. exesec:=TExeSection(ExeSectionList[i]);
  1820. exemap.AddMemoryMapExeSection(exesec);
  1821. for j:=0 to exesec.ObjSectionList.count-1 do
  1822. begin
  1823. objsec:=TObjSection(exesec.ObjSectionList[j]);
  1824. exemap.AddMemoryMapObjectSection(objsec);
  1825. for k:=0 to objsec.ObjSymbolDefines.Count-1 do
  1826. begin
  1827. objsym:=TObjSymbol(objsec.ObjSymbolDefines[k]);
  1828. exemap.AddMemoryMapSymbol(objsym);
  1829. end;
  1830. end;
  1831. end;
  1832. end;
  1833. procedure TExeOutput.FixupSymbols;
  1834. procedure UpdateSymbol(objsym:TObjSymbol);
  1835. begin
  1836. objsym.bind:=objsym.ExeSymbol.ObjSymbol.bind;
  1837. objsym.offset:=objsym.ExeSymbol.ObjSymbol.offset;
  1838. objsym.size:=objsym.ExeSymbol.ObjSymbol.size;
  1839. objsym.typ:=objsym.ExeSymbol.ObjSymbol.typ;
  1840. objsym.ObjSection:=objsym.ExeSymbol.ObjSymbol.ObjSection;
  1841. end;
  1842. var
  1843. i : longint;
  1844. objsym : TObjSymbol;
  1845. exesym : TExeSymbol;
  1846. begin
  1847. { Print list of Unresolved External symbols }
  1848. for i:=0 to UnresolvedExeSymbols.count-1 do
  1849. begin
  1850. exesym:=TExeSymbol(UnresolvedExeSymbols[i]);
  1851. if exesym.State<>symstate_defined then
  1852. Comment(V_Error,'Undefined symbol: '+exesym.name);
  1853. end;
  1854. { Update ImageBase to ObjData so it can access from ObjSymbols }
  1855. for i:=0 to ObjDataList.Count-1 do
  1856. TObjData(ObjDataList[i]).imagebase:=imagebase;
  1857. {
  1858. Fixing up symbols is done in the following steps:
  1859. 1. Update common references
  1860. 2. Update external references
  1861. }
  1862. { Step 1, Update commons }
  1863. for i:=0 to CommonObjSymbols.count-1 do
  1864. begin
  1865. objsym:=TObjSymbol(CommonObjSymbols[i]);
  1866. if objsym.bind<>AB_COMMON then
  1867. internalerror(200606241);
  1868. UpdateSymbol(objsym);
  1869. end;
  1870. { Step 2, Update externals }
  1871. for i:=0 to ExternalObjSymbols.count-1 do
  1872. begin
  1873. objsym:=TObjSymbol(ExternalObjSymbols[i]);
  1874. if objsym.bind<>AB_EXTERNAL then
  1875. internalerror(200606242);
  1876. UpdateSymbol(objsym);
  1877. end;
  1878. end;
  1879. procedure TExeOutput.MergeStabs;
  1880. var
  1881. stabexesec,
  1882. stabstrexesec : TExeSection;
  1883. relocsec,
  1884. currstabsec,
  1885. currstabstrsec,
  1886. mergedstabsec,
  1887. mergedstabstrsec : TObjSection;
  1888. hstabreloc,
  1889. currstabreloc : TObjRelocation;
  1890. currstabrelocidx,
  1891. i,j,
  1892. mergestabcnt,
  1893. stabcnt : longint;
  1894. skipstab : boolean;
  1895. skipfun : boolean;
  1896. hstab : TObjStabEntry;
  1897. stabrelocofs : longint;
  1898. buf : array[0..1023] of byte;
  1899. bufend,
  1900. bufsize : longint;
  1901. begin
  1902. stabexesec:=FindExeSection('.stab');
  1903. stabstrexesec:=FindExeSection('.stabstr');
  1904. if (stabexesec=nil) or
  1905. (stabstrexesec=nil) or
  1906. (stabexesec.ObjSectionlist.count=0) then
  1907. exit;
  1908. { Create new stabsection }
  1909. stabRelocofs:=pointer(@hstab.nvalue)-@hstab;
  1910. mergedstabsec:=internalObjData.CreateSection(sec_stab,'');
  1911. mergedstabstrsec:=internalObjData.CreateSection(sec_stabstr,'');
  1912. { write stab for hdrsym }
  1913. fillchar(hstab,sizeof(TObjStabEntry),0);
  1914. mergedstabsec.write(hstab,sizeof(TObjStabEntry));
  1915. mergestabcnt:=1;
  1916. { .stabstr starts with a #0 }
  1917. buf[0]:=0;
  1918. mergedstabstrsec.write(buf[0],1);
  1919. skipfun:=false;
  1920. { Copy stabs and corresponding Relocations }
  1921. for i:=0 to stabexesec.ObjSectionList.Count-1 do
  1922. begin
  1923. currstabsec:=TObjSection(stabexesec.ObjSectionList[i]);
  1924. currstabstrsec:=currstabsec.ObjData.findsection('.stabstr');
  1925. if assigned(currstabstrsec) then
  1926. begin
  1927. stabcnt:=currstabsec.Data.size div sizeof(TObjStabEntry);
  1928. currstabsec.Data.seek(0);
  1929. currstabrelocidx:=0;
  1930. for j:=0 to stabcnt-1 do
  1931. begin
  1932. hstabreloc:=nil;
  1933. skipstab:=false;
  1934. currstabsec.Data.read(hstab,sizeof(TObjStabEntry));
  1935. { Only include first hdrsym stab }
  1936. if hstab.ntype=0 then
  1937. skipstab:=true;
  1938. if skipfun then
  1939. begin
  1940. skipstab:=hstab.ntype in [N_TextLine,N_RSYM,N_LSYM,N_tsym,N_LBRAC,N_RBRAC,N_IncludeFile];
  1941. skipfun:=skipstab;
  1942. end;
  1943. if not skipstab then
  1944. begin
  1945. { Find corresponding Relocation }
  1946. currstabreloc:=nil;
  1947. while (currstabrelocidx<currstabsec.ObjRelocations.Count) do
  1948. begin
  1949. currstabreloc:=TObjRelocation(currstabsec.ObjRelocations[currstabrelocidx]);
  1950. if assigned(currstabreloc) and
  1951. (currstabreloc.dataoffset>=j*sizeof(TObjStabEntry)+stabrelocofs) then
  1952. break;
  1953. inc(currstabrelocidx);
  1954. end;
  1955. if assigned(currstabreloc) and
  1956. (currstabreloc.dataoffset=j*sizeof(TObjStabEntry)+stabrelocofs) then
  1957. begin
  1958. hstabReloc:=currstabReloc;
  1959. inc(currstabrelocidx);
  1960. end;
  1961. { Check if the stab is refering to a removed section }
  1962. if assigned(hstabreloc) then
  1963. begin
  1964. if assigned(hstabreloc.Symbol) then
  1965. relocsec:=hstabreloc.Symbol.ObjSection
  1966. else
  1967. relocsec:=hstabreloc.ObjSection;
  1968. if not assigned(relocsec) then
  1969. internalerror(200603302);
  1970. if not relocsec.Used then
  1971. begin
  1972. skipstab:=true;
  1973. if (hstab.ntype=N_Function) and (hstab.strpos<>0) then
  1974. begin
  1975. currstabstrsec.Data.seek(hstab.strpos);
  1976. bufsize:=currstabstrsec.Data.read(buf,sizeof(buf));
  1977. bufend:=indexbyte(buf,bufsize,Ord(':'));
  1978. if (bufend<>-1) and (bufend<bufsize-1) and (buf[bufend+1]=Ord('F')) then
  1979. skipfun:=true;
  1980. end;
  1981. end;
  1982. end;
  1983. end;
  1984. if not skipstab then
  1985. begin
  1986. { Copy string in stabstr }
  1987. if hstab.strpos<>0 then
  1988. begin
  1989. currstabstrsec.Data.seek(hstab.strpos);
  1990. hstab.strpos:=mergedstabstrsec.Size;
  1991. repeat
  1992. bufsize:=currstabstrsec.Data.read(buf,sizeof(buf));
  1993. bufend:=indexbyte(buf,bufsize,0);
  1994. if bufend=-1 then
  1995. bufend:=bufsize
  1996. else
  1997. begin
  1998. { include the #0 }
  1999. inc(bufend);
  2000. end;
  2001. mergedstabstrsec.write(buf,bufend);
  2002. until (buf[bufend-1]=0) or (bufsize<sizeof(buf));
  2003. end;
  2004. { Copy and Update the relocation }
  2005. if assigned(hstabreloc) then
  2006. begin
  2007. hstabreloc.Dataoffset:=mergestabcnt*sizeof(TObjStabEntry)+stabRelocofs;
  2008. { Remove from List without freeing the object }
  2009. currstabsec.ObjRelocations.List[currstabrelocidx-1]:=nil;
  2010. mergedstabsec.ObjRelocations.Add(hstabreloc);
  2011. end;
  2012. { Write updated stab }
  2013. mergedstabsec.write(hstab,sizeof(hstab));
  2014. inc(mergestabcnt);
  2015. end;
  2016. end;
  2017. end;
  2018. { Unload stabs }
  2019. if assigned(currstabstrsec) then
  2020. begin
  2021. currstabstrsec.Used:=False;
  2022. currstabstrsec.ReleaseData;
  2023. end;
  2024. currstabsec.Used:=false;
  2025. currstabsec.ReleaseData;
  2026. end;
  2027. { Generate new HdrSym }
  2028. if mergedstabsec.Size>0 then
  2029. begin
  2030. hstab.strpos:=1;
  2031. hstab.ntype:=0;
  2032. hstab.nother:=0;
  2033. hstab.ndesc:=word(mergestabcnt-1);
  2034. hstab.nvalue:=mergedstabstrsec.Size;
  2035. mergedstabsec.Data.seek(0);
  2036. mergedstabsec.Data.write(hstab,sizeof(hstab));
  2037. end;
  2038. { Replace all sections with our combined stabsec }
  2039. stabexesec.ObjSectionList.Clear;
  2040. stabstrexesec.ObjSectionList.Clear;
  2041. stabexesec.AddObjSection(mergedstabsec);
  2042. stabstrexesec.AddObjSection(mergedstabstrsec);
  2043. end;
  2044. procedure TExeOutput.RemoveEmptySections;
  2045. var
  2046. i, j : longint;
  2047. exesec : TExeSection;
  2048. doremove : boolean;
  2049. begin
  2050. for i:=0 to ExeSectionList.Count-1 do
  2051. begin
  2052. exesec:=TExeSection(ExeSectionList[i]);
  2053. if (cs_link_separate_dbg_file in current_settings.globalswitches) and
  2054. (oso_debug in exesec.SecOptions) then
  2055. begin
  2056. Comment(V_Debug,'Adding debug section '+exesec.name+' to debugfile');
  2057. ExeSectionList.OwnsObjects:=false;
  2058. ExeSectionList[i]:=nil;
  2059. ExeSectionList.OwnsObjects:=true;
  2060. DebugSectionList.Add(exesec.Name,exesec);
  2061. end
  2062. else
  2063. begin
  2064. doremove:=not(oso_keep in exesec.SecOptions) and
  2065. (
  2066. (exesec.ObjSectionlist.count=0) or
  2067. (
  2068. (cs_link_strip in current_settings.globalswitches) and
  2069. (oso_debug in exesec.SecOptions)
  2070. )
  2071. );
  2072. if not doremove then
  2073. begin
  2074. { Check if section has no actual data }
  2075. doremove:=true;
  2076. for j:=0 to exesec.ObjSectionList.Count-1 do
  2077. if TObjSection(exesec.ObjSectionList[j]).Size<>0 then
  2078. begin
  2079. doremove:=false;
  2080. break;
  2081. end;
  2082. end;
  2083. if doremove and not (RelocSection and (exesec.Name='.reloc')) then
  2084. begin
  2085. Comment(V_Debug,'Deleting empty section '+exesec.name);
  2086. ExeSectionList[i]:=nil;
  2087. end;
  2088. end;
  2089. end;
  2090. ExeSectionList.Pack;
  2091. end;
  2092. procedure TExeOutput.RemoveUnreferencedSections;
  2093. var
  2094. ObjSectionWorkList : TFPObjectList;
  2095. procedure AddToObjSectionWorkList(aobjsec:TObjSection);
  2096. begin
  2097. if not aobjsec.Used then
  2098. begin
  2099. aobjsec.Used:=true;
  2100. ObjSectionWorkList.Add(aobjsec);
  2101. end;
  2102. end;
  2103. procedure DoReloc(objreloc:TObjRelocation);
  2104. var
  2105. objsym : TObjSymbol;
  2106. refobjsec : TObjSection;
  2107. begin
  2108. { Disabled Relocation to 0 }
  2109. if objreloc.typ=RELOC_ZERO then
  2110. exit;
  2111. if assigned(objreloc.symbol) then
  2112. begin
  2113. objsym:=objreloc.symbol;
  2114. if objsym.bind<>AB_LOCAL then
  2115. begin
  2116. if not(assigned(objsym.exesymbol) and
  2117. (objsym.exesymbol.State=symstate_defined)) then
  2118. internalerror(200603063);
  2119. objsym:=objsym.exesymbol.objsymbol;
  2120. end;
  2121. if not assigned(objsym.objsection) then
  2122. internalerror(200603062);
  2123. refobjsec:=objsym.objsection;
  2124. end
  2125. else
  2126. if assigned(objreloc.objsection) then
  2127. refobjsec:=objreloc.objsection
  2128. else
  2129. internalerror(200603316);
  2130. if assigned(exemap) then
  2131. begin
  2132. objsym:=objreloc.symbol;
  2133. if assigned(objsym) then
  2134. exemap.Add(' References '+objsym.name+' in '
  2135. +refobjsec.fullname)
  2136. else
  2137. exemap.Add(' References '+refobjsec.fullname);
  2138. end;
  2139. AddToObjSectionWorkList(refobjsec);
  2140. end;
  2141. procedure DoVTableRef(vtable:TExeVTable;VTableIdx:longint);
  2142. var
  2143. i : longint;
  2144. objreloc : TObjRelocation;
  2145. begin
  2146. objreloc:=vtable.VTableRef(VTableIdx);
  2147. if assigned(objreloc) then
  2148. begin
  2149. { Process the relocation now if the ObjSection is
  2150. already processed and marked as used. Otherwise we leave it
  2151. unprocessed. It'll then be resolved when the ObjSection is
  2152. changed to Used }
  2153. if vtable.ExeSymbol.ObjSymbol.ObjSection.Used then
  2154. DoReloc(objreloc);
  2155. end;
  2156. { This recursive walking is done here instead of
  2157. in TExeVTable.VTableRef because we can now process
  2158. all needed relocations }
  2159. for i:=0 to vtable.ChildList.Count-1 do
  2160. DoVTableRef(TExeVTable(vtable.ChildList[i]),VTableIdx);
  2161. end;
  2162. var
  2163. hs : string;
  2164. i,j,k : longint;
  2165. exesec : TExeSection;
  2166. objdata : TObjData;
  2167. objsec : TObjSection;
  2168. objsym : TObjSymbol;
  2169. code : integer;
  2170. vtableidx : longint;
  2171. vtableexesym : TExeSymbol;
  2172. begin
  2173. ObjSectionWorkList:=TFPObjectList.Create(false);
  2174. if assigned(exemap) then
  2175. exemap.AddHeader('Removing unreferenced sections');
  2176. { Initialize by marking all sections unused and
  2177. adding the sections with oso_keep flags to the ObjSectionWorkList }
  2178. for i:=0 to ObjDataList.Count-1 do
  2179. begin
  2180. ObjData:=TObjData(ObjDataList[i]);
  2181. for j:=0 to ObjData.ObjSectionList.Count-1 do
  2182. begin
  2183. objsec:=TObjSection(ObjData.ObjSectionList[j]);
  2184. objsec.Used:=false;
  2185. {$warning TODO remove debug section always keep}
  2186. if oso_debug in objsec.secoptions then
  2187. objsec.Used:=true;
  2188. if (oso_keep in objsec.secoptions) then
  2189. begin
  2190. AddToObjSectionWorkList(objsec);
  2191. if objsec.name='.fpc.n_links' then
  2192. objsec.Used:=false;
  2193. end;
  2194. end;
  2195. end;
  2196. AddToObjSectionWorkList(entrysym.exesymbol.objsymbol.objsection);
  2197. { Process all sections, add new sections to process based
  2198. on the symbol references }
  2199. while ObjSectionWorkList.Count>0 do
  2200. begin
  2201. objsec:=TObjSection(ObjSectionWorkList.Last);
  2202. if assigned(exemap) then
  2203. exemap.Add('Keeping '+objsec.FullName+' '+ToStr(objsec.ObjRelocations.Count)+' references');
  2204. ObjSectionWorkList.Delete(ObjSectionWorkList.Count-1);
  2205. { Process Relocations }
  2206. for i:=0 to objsec.ObjRelocations.count-1 do
  2207. DoReloc(TObjRelocation(objsec.ObjRelocations[i]));
  2208. { Process Virtual Entry calls }
  2209. if cs_link_opt_vtable in current_settings.globalswitches then
  2210. begin
  2211. for i:=0 to objsec.VTRefList.count-1 do
  2212. begin
  2213. objsym:=TObjSymbol(objsec.VTRefList[i]);
  2214. hs:=objsym.name;
  2215. Delete(hs,1,Pos('_',hs));
  2216. k:=Pos('$$',hs);
  2217. if k=0 then
  2218. internalerror(200603314);
  2219. vtableexesym:=texesymbol(FExeSymbolList.Find(Copy(hs,1,k-1)));
  2220. val(Copy(hs,k+2,length(hs)-k-1),vtableidx,code);
  2221. if (code<>0) then
  2222. internalerror(200603317);
  2223. if not assigned(vtableexesym) then
  2224. internalerror(200603315);
  2225. if not assigned(vtableexesym.vtable) then
  2226. internalerror(200603316);
  2227. DoVTableRef(vtableexesym.vtable,vtableidx);
  2228. end;
  2229. end;
  2230. end;
  2231. ObjSectionWorkList.Free;
  2232. ObjSectionWorkList:=nil;
  2233. { Remove unused objsections from ExeSectionList }
  2234. for i:=0 to ExeSectionList.Count-1 do
  2235. begin
  2236. exesec:=TExeSection(ExeSectionList[i]);
  2237. for j:=0 to exesec.ObjSectionlist.count-1 do
  2238. begin
  2239. objsec:=TObjSection(exesec.ObjSectionlist[j]);
  2240. if not objsec.used then
  2241. begin
  2242. if assigned(exemap) then
  2243. exemap.Add('Removing '+objsec.FullName);
  2244. exesec.ObjSectionlist[j]:=nil;
  2245. objsec.ReleaseData;
  2246. end;
  2247. end;
  2248. exesec.ObjSectionlist.Pack;
  2249. end;
  2250. end;
  2251. procedure TExeOutput.FixupRelocations;
  2252. procedure FixupSectionList(List:TFPHashObjectList);
  2253. var
  2254. i,j : longint;
  2255. exesec : TExeSection;
  2256. objsec : TObjSection;
  2257. begin
  2258. for i:=0 to List.Count-1 do
  2259. begin
  2260. exesec:=TExeSection(List[i]);
  2261. if not assigned(exesec) then
  2262. continue;
  2263. for j:=0 to exesec.ObjSectionlist.count-1 do
  2264. begin
  2265. objsec:=TObjSection(exesec.ObjSectionlist[j]);
  2266. if not objsec.Used then
  2267. internalerror(200603301);
  2268. objsec.FixupRelocs;
  2269. end;
  2270. end;
  2271. end;
  2272. begin
  2273. FixupSectionList(ExeSectionList);
  2274. FixupSectionList(DebugSectionList);
  2275. end;
  2276. {****************************************************************************
  2277. TObjInput
  2278. ****************************************************************************}
  2279. constructor TObjInput.create;
  2280. begin
  2281. end;
  2282. destructor TObjInput.destroy;
  2283. begin
  2284. inherited destroy;
  2285. end;
  2286. function TObjInput.newObjData(const n:string):TObjData;
  2287. begin
  2288. result:=CObjData.create(n);
  2289. end;
  2290. procedure TObjInput.inputerror(const s : string);
  2291. begin
  2292. Comment(V_Error,s+' while reading '+InputFileName);
  2293. end;
  2294. {$ifdef MEMDEBUG}
  2295. initialization
  2296. memobjsymbols:=TMemDebug.create('ObjSymbols');
  2297. memobjsymbols.stop;
  2298. memobjsections:=TMemDebug.create('ObjSections');
  2299. memobjsections.stop;
  2300. finalization
  2301. memobjsymbols.free;
  2302. memobjsections.free;
  2303. {$endif MEMDEBUG}
  2304. end.