ogbase.pas 77 KB

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