ogbase.pas 77 KB

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