ogbase.pas 102 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084
  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. TExeOutput = class;
  36. TObjRelocationType = (
  37. { Relocation to absolute address }
  38. RELOC_ABSOLUTE,
  39. {$ifdef x86_64}
  40. { 32bit Relocation to absolute address }
  41. RELOC_ABSOLUTE32,
  42. { 64 bit coff only }
  43. RELOC_RELATIVE_1,
  44. RELOC_RELATIVE_2,
  45. RELOC_RELATIVE_3,
  46. RELOC_RELATIVE_4,
  47. RELOC_RELATIVE_5,
  48. { PIC }
  49. RELOC_GOTPCREL,
  50. RELOC_PLT32,
  51. {$endif x86_64}
  52. {$ifdef i386}
  53. { PIC }
  54. RELOC_GOTPC,
  55. RELOC_GOT32,
  56. RELOC_PLT32,
  57. {$endif i386}
  58. {$ifdef arm}
  59. RELOC_RELATIVE_24,
  60. {$endif arm}
  61. { Relative relocation }
  62. RELOC_RELATIVE,
  63. { PECoff (Windows) RVA relocation }
  64. RELOC_RVA,
  65. { PECoff (Windows) section relocation, required by DWARF2 debug info }
  66. RELOC_SECREL32,
  67. { Generate a 0 value at the place of the relocation,
  68. this is used to remove unused vtable entries }
  69. RELOC_ZERO,
  70. { No relocation is needed. It is used in ARM object files.
  71. Also internal linker use this reloc to make virtual (not real)
  72. links to some sections }
  73. RELOC_NONE,
  74. { Darwin relocation, using PAIR }
  75. RELOC_PIC_PAIR
  76. );
  77. {$ifndef x86_64}
  78. const
  79. RELOC_ABSOLUTE32 = RELOC_ABSOLUTE;
  80. {$endif x86_64}
  81. const
  82. { stab types }
  83. N_GSYM = $20;
  84. N_STSYM = 38; { initialized const }
  85. N_LCSYM = 40; { non initialized variable}
  86. N_Function = $24; { function or const }
  87. N_TextLine = $44;
  88. N_DataLine = $46;
  89. N_BssLine = $48;
  90. N_RSYM = $40; { register variable }
  91. N_LSYM = $80;
  92. N_tsym = 160;
  93. N_SourceFile = $64;
  94. N_IncludeFile = $84;
  95. N_BINCL = $82;
  96. N_EINCL = $A2;
  97. N_LBRAC = $C0;
  98. N_EXCL = $C2;
  99. N_RBRAC = $E0;
  100. { GNU extensions }
  101. debuglinkname='.gnu_debuglink';
  102. type
  103. TObjSectionOption = (
  104. { Has Data available in the file }
  105. oso_Data,
  106. { Is loaded into memory }
  107. oso_load,
  108. { Writable }
  109. oso_write,
  110. { Contains executable instructions }
  111. oso_executable,
  112. { Never discard section }
  113. oso_keep,
  114. { Special common symbols }
  115. oso_common,
  116. { Contains debug info and can be stripped }
  117. oso_debug,
  118. { Contains only strings }
  119. oso_strings,
  120. { Ignore this section }
  121. oso_disabled
  122. );
  123. TObjSectionOptions = set of TObjSectionOption;
  124. TObjSymbol = class(TFPHashObject)
  125. public
  126. bind : TAsmsymbind;
  127. typ : TAsmsymtype;
  128. { Current assemble pass, used to detect duplicate labels }
  129. pass : byte;
  130. objsection : TObjSection;
  131. symidx : longint;
  132. offset,
  133. size : aword;
  134. { Used for external and common solving during linking }
  135. exesymbol : TExeSymbol;
  136. { Darwin asm is using indirect symbols resolving }
  137. indsymbol : TObjSymbol;
  138. constructor create(AList:TFPHashObjectList;const AName:string);
  139. function address:aword;
  140. procedure SetAddress(apass:byte;aobjsec:TObjSection;abind:TAsmsymbind;atyp:Tasmsymtype);
  141. end;
  142. { Stabs is common for all targets }
  143. TObjStabEntry=packed record
  144. strpos : longint;
  145. ntype : byte;
  146. nother : byte;
  147. ndesc : word;
  148. nvalue : longint;
  149. end;
  150. PObjStabEntry=^TObjStabEntry;
  151. TObjRelocation = class
  152. DataOffset,
  153. orgsize : aword; { COFF: original size of the symbol to relocate }
  154. { ELF: explicit addend }
  155. symbol : TObjSymbol;
  156. objsection : TObjSection; { only used if symbol=nil }
  157. typ : TObjRelocationType;
  158. size : byte;
  159. constructor CreateSymbol(ADataOffset:aword;s:TObjSymbol;Atyp:TObjRelocationType);
  160. constructor CreateSymbolSize(ADataOffset:aword;s:TObjSymbol;Aorgsize:aword;Atyp:TObjRelocationType);
  161. constructor CreateSection(ADataOffset:aword;aobjsec:TObjSection;Atyp:TObjRelocationType);
  162. end;
  163. TObjSection = class(TFPHashObject)
  164. private
  165. FData : TDynamicArray;
  166. FSecOptions : TObjSectionOptions;
  167. FCachedFullName : pshortstring;
  168. procedure SetSecOptions(Aoptions:TObjSectionOptions);
  169. public
  170. ObjData : TObjData;
  171. index : longword; { index of section in section headers }
  172. SecSymIdx : longint; { index for the section in symtab }
  173. SecAlign : shortint; { alignment of the section }
  174. { section Data }
  175. Size,
  176. DataPos,
  177. MemPos : aword;
  178. DataAlignBytes : shortint;
  179. { Relocations (=references) to other sections }
  180. ObjRelocations : TFPObjectList;
  181. { executable linking }
  182. ExeSection : TExeSection;
  183. USed : Boolean;
  184. VTRefList : TFPObjectList;
  185. constructor create(AList:TFPHashObjectList;const Aname:string;Aalign:shortint;Aoptions:TObjSectionOptions);virtual;
  186. destructor destroy;override;
  187. function write(const d;l:aword):aword;
  188. function writestr(const s:string):aword;
  189. function WriteZeros(l:longword):aword;
  190. procedure writeReloc_internal(aTarget:TObjSection;offset:aword;len:byte;reltype:TObjRelocationType);virtual;
  191. function setmempos(mpos:qword):qword;
  192. procedure setDatapos(var dpos:aword);
  193. procedure alloc(l:aword);
  194. procedure addsymReloc(ofs:aword;p:TObjSymbol;Reloctype:TObjRelocationType);
  195. procedure addsectionReloc(ofs:aword;aobjsec:TObjSection;Reloctype:TObjRelocationType);
  196. procedure ReleaseData;
  197. function FullName:string;
  198. property Data:TDynamicArray read FData;
  199. property SecOptions:TObjSectionOptions read FSecOptions write SetSecOptions;
  200. end;
  201. TObjSectionClass = class of TObjSection;
  202. TString80 = string[80];
  203. TObjData = class(TLinkedListItem)
  204. private
  205. FCurrObjSec : TObjSection;
  206. FObjSectionList : TFPHashObjectList;
  207. FCObjSection : TObjSectionClass;
  208. { Symbols that will be defined in this object file }
  209. FObjSymbolList : TFPHashObjectList;
  210. FCachedAsmSymbolList : TFPObjectList;
  211. { Special info sections that are written to during object generation }
  212. FStabsObjSec,
  213. FStabStrObjSec : TObjSection;
  214. procedure section_reset(p:TObject;arg:pointer);
  215. procedure section_afteralloc(p:TObject;arg:pointer);
  216. procedure section_afterwrite(p:TObject;arg:pointer);
  217. protected
  218. FName : TString80;
  219. property CObjSection:TObjSectionClass read FCObjSection write FCObjSection;
  220. public
  221. CurrPass : byte;
  222. ExecStack : boolean;
  223. constructor create(const n:string);virtual;
  224. destructor destroy;override;
  225. { Sections }
  226. function sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;virtual;
  227. function sectiontype2options(atype:TAsmSectiontype):TObjSectionOptions;virtual;
  228. function sectiontype2align(atype:TAsmSectiontype):shortint;virtual;
  229. function createsection(atype:TAsmSectionType;const aname:string='';aorder:TAsmSectionOrder=secorder_default):TObjSection;
  230. function createsection(const aname:string;aalign:shortint;aoptions:TObjSectionOptions;DiscardDuplicate:boolean=true):TObjSection;virtual;
  231. procedure CreateDebugSections;virtual;
  232. function findsection(const aname:string):TObjSection;
  233. procedure setsection(asec:TObjSection);
  234. { Symbols }
  235. function createsymbol(const aname:string):TObjSymbol;
  236. function symboldefine(asmsym:TAsmSymbol):TObjSymbol;
  237. function symboldefine(const aname:string;abind:TAsmsymbind;atyp:Tasmsymtype):TObjSymbol;
  238. function symbolref(asmsym:TAsmSymbol):TObjSymbol;
  239. function symbolref(const aname:string):TObjSymbol;
  240. procedure ResetCachedAsmSymbols;
  241. { Allocation }
  242. procedure alloc(len:aword);
  243. procedure allocalign(len:shortint);
  244. procedure writebytes(const Data;len:aword);
  245. procedure writeReloc(Data:aint;len:aword;p:TObjSymbol;Reloctype:TObjRelocationType);virtual;abstract;
  246. procedure beforealloc;virtual;
  247. procedure beforewrite;virtual;
  248. procedure afteralloc;virtual;
  249. procedure afterwrite;virtual;
  250. procedure resetsections;
  251. procedure layoutsections(var datapos:aword);
  252. property Name:TString80 read FName;
  253. property CurrObjSec:TObjSection read FCurrObjSec;
  254. property ObjSymbolList:TFPHashObjectList read FObjSymbolList;
  255. property ObjSectionList:TFPHashObjectList read FObjSectionList;
  256. property StabsSec:TObjSection read FStabsObjSec write FStabsObjSec;
  257. property StabStrSec:TObjSection read FStabStrObjSec write FStabStrObjSec;
  258. end;
  259. TObjDataClass = class of TObjData;
  260. TObjOutput = class
  261. private
  262. FCObjData : TObjDataClass;
  263. protected
  264. { writer }
  265. FWriter : TObjectwriter;
  266. function writeData(Data:TObjData):boolean;virtual;abstract;
  267. property CObjData : TObjDataClass read FCObjData write FCObjData;
  268. procedure WriteSectionContent(Data:TObjData);
  269. public
  270. constructor create(AWriter:TObjectWriter);virtual;
  271. destructor destroy;override;
  272. function newObjData(const n:string):TObjData;
  273. function startObjectfile(const fn:string):boolean;
  274. function writeobjectfile(Data:TObjData):boolean;
  275. procedure exportsymbol(p:TObjSymbol);
  276. property Writer:TObjectWriter read FWriter;
  277. end;
  278. TObjOutputClass=class of TObjOutput;
  279. TObjInput = class
  280. private
  281. FCObjData : TObjDataClass;
  282. protected
  283. { reader }
  284. FReader : TObjectReader;
  285. InputFileName : string;
  286. property CObjData : TObjDataClass read FCObjData write FCObjData;
  287. procedure ReadSectionContent(Data:TObjData);
  288. public
  289. constructor create;virtual;
  290. destructor destroy;override;
  291. function newObjData(const n:string):TObjData;
  292. function ReadObjData(AReader:TObjectreader;Data:TObjData):boolean;virtual;abstract;
  293. class function CanReadObjData(AReader:TObjectreader):boolean;virtual;
  294. procedure inputerror(const s : string);
  295. end;
  296. TObjInputClass=class of TObjInput;
  297. TVTableEntry=record
  298. ObjRelocation : TObjRelocation;
  299. orgreloctype : TObjRelocationType;
  300. Enabled,
  301. Used : Boolean;
  302. end;
  303. PVTableEntry=^TVTableEntry;
  304. TExeVTable = class
  305. private
  306. procedure CheckIdx(VTableIdx:longint);
  307. public
  308. ExeSymbol : TExeSymbol;
  309. EntryCnt : Longint;
  310. EntryArray : PVTableEntry;
  311. Consolidated : Boolean;
  312. ChildList : TFPObjectList;
  313. constructor Create(AExeSymbol:TExeSymbol);
  314. destructor Destroy;override;
  315. procedure AddChild(vt:TExeVTable);
  316. procedure AddEntry(VTableIdx:Longint);
  317. procedure SetVTableSize(ASize:longint);
  318. function VTableRef(VTableIdx:Longint):TObjRelocation;
  319. end;
  320. TSymbolState = (symstate_undefined,symstate_defined,symstate_common);
  321. TExeSymbol = class(TFPHashObject)
  322. ObjSymbol : TObjSymbol;
  323. State : TSymbolState;
  324. { Used for vmt references optimization }
  325. VTable : TExeVTable;
  326. end;
  327. TExeSection = class(TFPHashObject)
  328. private
  329. FSecSymIdx : longint;
  330. FObjSectionList : TFPObjectList;
  331. public
  332. Size,
  333. DataPos,
  334. MemPos : aword;
  335. SecAlign : shortint;
  336. SecOptions : TObjSectionOptions;
  337. constructor create(AList:TFPHashObjectList;const AName:string);virtual;
  338. destructor destroy;override;
  339. procedure AddObjSection(objsec:TObjSection);virtual;
  340. property ObjSectionList:TFPObjectList read FObjSectionList;
  341. property SecSymIdx:longint read FSecSymIdx write FSecSymIdx;
  342. end;
  343. TExeSectionClass=class of TExeSection;
  344. TStaticLibrary = class(TObject)
  345. private
  346. FName : TCmdStr;
  347. FArReader : TObjectReader;
  348. FObjInputClass : TObjInputClass;
  349. public
  350. constructor create(const AName:TCmdStr;AReader:TObjectReader;AObjInputClass:TObjInputClass);
  351. destructor destroy;override;
  352. property ArReader:TObjectReader read FArReader;
  353. property ObjInputClass:TObjInputClass read FObjInputClass;
  354. end;
  355. TImportLibrary = class(TFPHashObject)
  356. private
  357. FImportSymbolList : TFPHashObjectList;
  358. public
  359. constructor create(AList:TFPHashObjectList;const AName:string);
  360. destructor destroy;override;
  361. property ImportSymbolList:TFPHashObjectList read FImportSymbolList;
  362. end;
  363. TImportSymbol = class(TFPHashObject)
  364. private
  365. FOrdNr : longint;
  366. FIsVar : boolean;
  367. FMangledName : string;
  368. public
  369. constructor create(AList:TFPHashObjectList;const AName,AMangledName:string;AOrdNr:longint;AIsVar:boolean);
  370. property OrdNr: longint read FOrdNr;
  371. property MangledName: string read FMangledName;
  372. property IsVar: boolean read FIsVar;
  373. end;
  374. TExeWriteMode = (ewm_exefull,ewm_dbgonly,ewm_exeonly);
  375. TExeOutput = class
  376. private
  377. { ExeSectionList }
  378. FCObjData : TObjDataClass;
  379. FCExeSection : TExeSectionClass;
  380. FCurrExeSec : TExeSection;
  381. FExeSectionList : TFPHashObjectList;
  382. Fzeronr : longint;
  383. Fvaluesnr : longint;
  384. { Symbols }
  385. FExeSymbolList : TFPHashObjectList;
  386. FUnresolvedExeSymbols : TFPObjectList;
  387. FExternalObjSymbols,
  388. FCommonObjSymbols : TFPObjectList;
  389. FProvidedObjSymbols : TFPObjectList;
  390. FEntryName : string;
  391. FExeVTableList : TFPObjectList;
  392. { Objects }
  393. FObjDataList : TFPObjectList;
  394. { Position calculation }
  395. FImageBase : aword;
  396. FCurrMemPos : qword;
  397. procedure SetCurrMemPos(const AValue: qword);
  398. protected
  399. { writer }
  400. FExeWriteMode : TExeWriteMode;
  401. FWriter : TObjectwriter;
  402. commonObjSection : TObjSection;
  403. internalObjData : TObjData;
  404. EntrySym : TObjSymbol;
  405. SectionDataAlign,
  406. SectionMemAlign : aword;
  407. function writeData:boolean;virtual;abstract;
  408. property CExeSection:TExeSectionClass read FCExeSection write FCExeSection;
  409. property CObjData:TObjDataClass read FCObjData write FCObjData;
  410. procedure Order_ObjSectionList(ObjSectionList : TFPObjectList; const aPattern:string);virtual;
  411. procedure WriteExeSectionContent;
  412. procedure DoRelocationFixup(objsec:TObjSection);virtual;abstract;
  413. public
  414. CurrDataPos : aword;
  415. MaxMemPos : qword;
  416. IsSharedLibrary : boolean;
  417. ExecStack : boolean;
  418. constructor create;virtual;
  419. destructor destroy;override;
  420. function FindExeSection(const aname:string):TExeSection;
  421. procedure AddObjData(ObjData:TObjData);
  422. procedure Load_Start;virtual;
  423. procedure Load_EntryName(const aname:string);virtual;
  424. procedure Load_Symbol(const aname:string);virtual;
  425. procedure Load_ProvideSymbol(const aname:string);virtual;
  426. procedure Load_IsSharedLibrary;
  427. procedure Load_ImageBase(const avalue:string);
  428. procedure Load_DynamicObject(ObjData:TObjData);virtual;
  429. procedure Order_Start;virtual;
  430. procedure Order_End;virtual;
  431. procedure Order_ExeSection(const aname:string);virtual;
  432. procedure Order_Align(const avalue:string);virtual;
  433. procedure Order_Zeros(const avalue:string);virtual;
  434. procedure Order_Values(bytesize : aword; const avalue:string);virtual;
  435. procedure Order_Symbol(const aname:string);virtual;
  436. procedure Order_ProvideSymbol(const aname:string);virtual;
  437. procedure Order_EndExeSection;virtual;
  438. procedure Order_ObjSection(const aname:string);virtual;
  439. procedure MemPos_Start;virtual;
  440. procedure MemPos_Header;virtual;
  441. procedure MemPos_ExeSection(exesec:TExeSection);
  442. procedure MemPos_ExeSection(const aname:string);virtual;
  443. procedure MemPos_EndExeSection;virtual;
  444. procedure DataPos_Start;virtual;
  445. procedure DataPos_Header;virtual;
  446. procedure DataPos_ExeSection(exesec:TExeSection);
  447. procedure DataPos_ExeSection(const aname:string);virtual;
  448. procedure DataPos_EndExeSection;virtual;
  449. procedure DataPos_Symbols;virtual;
  450. procedure BuildVTableTree(VTInheritList,VTEntryList:TFPObjectList);
  451. procedure PackUnresolvedExeSymbols(const s:string);
  452. procedure ResolveSymbols(StaticLibraryList:TFPObjectList);
  453. procedure PrintMemoryMap;
  454. procedure FixupSymbols;
  455. procedure FixupRelocations;
  456. procedure RemoveUnusedExeSymbols;
  457. procedure MergeStabs;
  458. procedure MarkEmptySections;
  459. procedure RemoveUnreferencedSections;
  460. procedure RemoveDisabledSections;
  461. procedure RemoveDebugInfo;
  462. procedure GenerateLibraryImports(ImportLibraryList:TFPHashObjectList);virtual;
  463. procedure GenerateDebugLink(const dbgname:string;dbgcrc:cardinal);
  464. function WriteExeFile(const fn:string):boolean;
  465. procedure ParseScript (linkscript:TCmdStrList); virtual;
  466. property Writer:TObjectWriter read FWriter;
  467. property ExeSectionList:TFPHashObjectList read FExeSectionList;
  468. property ObjDataList:TFPObjectList read FObjDataList;
  469. property ExeSymbolList:TFPHashObjectList read FExeSymbolList;
  470. property UnresolvedExeSymbols:TFPObjectList read FUnresolvedExeSymbols;
  471. property ExternalObjSymbols:TFPObjectList read FExternalObjSymbols;
  472. property CommonObjSymbols:TFPObjectList read FCommonObjSymbols;
  473. property ExeVTableList:TFPObjectList read FExeVTableList;
  474. property EntryName:string read FEntryName write FEntryName;
  475. property ImageBase:aword read FImageBase write FImageBase;
  476. property CurrExeSec:TExeSection read FCurrExeSec;
  477. property ExeWriteMode:TExeWriteMode read FExeWriteMode write FExeWriteMode;
  478. property CurrMemPos:qword read FCurrMemPos write SetCurrMemPos;
  479. end;
  480. TExeOutputClass=class of TExeOutput;
  481. var
  482. exeoutput : TExeOutput;
  483. implementation
  484. uses
  485. SysUtils,
  486. globals,verbose,fmodule,ogmap;
  487. const
  488. SectionDataMaxGrow = 4096;
  489. {$ifdef MEMDEBUG}
  490. var
  491. memobjsymbols,
  492. memobjsections : TMemDebug;
  493. {$endif MEMDEBUG}
  494. {*****************************************************************************
  495. TObjSymbol
  496. *****************************************************************************}
  497. constructor TObjSymbol.create(AList:TFPHashObjectList;const AName:string);
  498. begin;
  499. inherited create(AList,AName);
  500. bind:=AB_EXTERNAL;
  501. typ:=AT_NONE;
  502. symidx:=-1;
  503. size:=0;
  504. offset:=0;
  505. objsection:=nil;
  506. end;
  507. function TObjSymbol.address:aword;
  508. begin
  509. if assigned(objsection) then
  510. result:=offset+objsection.mempos
  511. else
  512. result:=0;
  513. end;
  514. procedure TObjSymbol.SetAddress(apass:byte;aobjsec:TObjSection;abind:TAsmsymbind;atyp:Tasmsymtype);
  515. begin
  516. if not(abind in [AB_GLOBAL,AB_LOCAL,AB_COMMON,AB_IMPORT]) then
  517. internalerror(200603016);
  518. if not assigned(aobjsec) then
  519. internalerror(200603017);
  520. if (bind in [AB_EXTERNAL,AB_LAZY]) or
  521. { Put all COMMON to GLOBAL in step 3 of
  522. TExeOutput.ResolveSymbols }
  523. ((abind=AB_GLOBAL) and (bind=AB_COMMON)) then
  524. begin
  525. { Do not change the AB_TYPE of common symbols yet }
  526. { This will be done in FixupSymbols }
  527. if (pass<>0) or (bind<>AB_COMMON) then
  528. bind:=abind;
  529. typ:=atyp;
  530. end
  531. else
  532. begin
  533. if pass=apass then
  534. begin
  535. Message1(asmw_e_duplicate_label,name);
  536. exit;
  537. end;
  538. end;
  539. pass:=apass;
  540. { Code can never grow after a pass }
  541. if assigned(objsection) and
  542. (objsection=aobjsec) and
  543. (aobjsec.size>offset) then
  544. internalerror(200603014);
  545. objsection:=aobjsec;
  546. offset:=aobjsec.size;
  547. end;
  548. {****************************************************************************
  549. TObjRelocation
  550. ****************************************************************************}
  551. constructor TObjRelocation.CreateSymbol(ADataOffset:aword;s:TObjSymbol;Atyp:TObjRelocationType);
  552. begin
  553. if not assigned(s) then
  554. internalerror(200603034);
  555. DataOffset:=ADataOffset;
  556. Symbol:=s;
  557. OrgSize:=0;
  558. ObjSection:=nil;
  559. Typ:=Atyp;
  560. end;
  561. constructor TObjRelocation.CreateSymbolSize(ADataOffset:aword;s:TObjSymbol;Aorgsize:aword;Atyp:TObjRelocationType);
  562. begin
  563. if not assigned(s) then
  564. internalerror(200603035);
  565. DataOffset:=ADataOffset;
  566. Symbol:=s;
  567. OrgSize:=Aorgsize;
  568. ObjSection:=nil;
  569. Typ:=Atyp;
  570. end;
  571. constructor TObjRelocation.CreateSection(ADataOffset:aword;aobjsec:TObjSection;Atyp:TObjRelocationType);
  572. begin
  573. if not assigned(aobjsec) then
  574. internalerror(200603036);
  575. DataOffset:=ADataOffset;
  576. Symbol:=nil;
  577. OrgSize:=0;
  578. ObjSection:=aobjsec;
  579. Typ:=Atyp;
  580. end;
  581. {****************************************************************************
  582. TObjSection
  583. ****************************************************************************}
  584. constructor TObjSection.create(AList:TFPHashObjectList;const Aname:string;Aalign:shortint;Aoptions:TObjSectionOptions);
  585. begin
  586. inherited Create(AList,Aname);
  587. { Data }
  588. Size:=0;
  589. Datapos:=0;
  590. mempos:=0;
  591. FData:=Nil;
  592. { Setting the secoptions allocates Data if needed }
  593. secoptions:=Aoptions;
  594. secalign:=Aalign;
  595. secsymidx:=0;
  596. { relocation }
  597. ObjRelocations:=TFPObjectList.Create(true);
  598. VTRefList:=TFPObjectList.Create(false);
  599. end;
  600. destructor TObjSection.destroy;
  601. begin
  602. if assigned(Data) then
  603. Data.Free;
  604. stringdispose(FCachedFullName);
  605. ObjRelocations.Free;
  606. VTRefList.Free;
  607. inherited destroy;
  608. end;
  609. procedure TObjSection.SetSecOptions(Aoptions:TObjSectionOptions);
  610. begin
  611. FSecOptions:=FSecOptions+AOptions;
  612. if (oso_Data in secoptions) and
  613. not assigned(FData) then
  614. FData:=TDynamicArray.Create(SectionDataMaxGrow);
  615. end;
  616. function TObjSection.write(const d;l:aword):aword;
  617. begin
  618. result:=size;
  619. if assigned(Data) then
  620. begin
  621. if Size<>Data.size then
  622. internalerror(200602281);
  623. Data.write(d,l);
  624. inc(Size,l);
  625. end
  626. else
  627. internalerror(200602289);
  628. end;
  629. function TObjSection.writestr(const s:string):aword;
  630. begin
  631. result:=Write(s[1],length(s));
  632. end;
  633. function TObjSection.WriteZeros(l:longword):aword;
  634. var
  635. empty : array[0..1023] of byte;
  636. begin
  637. if l>sizeof(empty) then
  638. internalerror(200404082);
  639. if l>0 then
  640. begin
  641. fillchar(empty,l,0);
  642. result:=Write(empty,l);
  643. end
  644. else
  645. result:=Size;
  646. end;
  647. { Writes relocation to (section+offset) without need to have a symbol at that location.
  648. Not an abstract method because not every backend needs this functionality. }
  649. procedure TObjSection.writeReloc_internal(aTarget:TObjSection;offset:aword;len:byte;reltype:TObjRelocationType);
  650. begin
  651. InternalError(2012081501);
  652. end;
  653. procedure TObjSection.setDatapos(var dpos:aword);
  654. begin
  655. if oso_Data in secoptions then
  656. begin
  657. { get aligned Datapos }
  658. Datapos:=align(dpos,secalign);
  659. Dataalignbytes:=Datapos-dpos;
  660. { return updated Datapos }
  661. dpos:=Datapos+size;
  662. end
  663. else
  664. Datapos:=dpos;
  665. end;
  666. function TObjSection.setmempos(mpos:qword):qword;
  667. begin
  668. mempos:=align(mpos,secalign);
  669. { return updated mempos }
  670. result:=mempos+size;
  671. end;
  672. procedure TObjSection.alloc(l:aword);
  673. begin
  674. inc(size,l);
  675. end;
  676. procedure TObjSection.addsymReloc(ofs:aword;p:TObjSymbol;Reloctype:TObjRelocationType);
  677. begin
  678. ObjRelocations.Add(TObjRelocation.CreateSymbol(ofs,p,reloctype));
  679. end;
  680. procedure TObjSection.addsectionReloc(ofs:aword;aobjsec:TObjSection;Reloctype:TObjRelocationType);
  681. begin
  682. ObjRelocations.Add(TObjRelocation.CreateSection(ofs,aobjsec,reloctype));
  683. end;
  684. procedure TObjSection.ReleaseData;
  685. begin
  686. if assigned(FData) then
  687. begin
  688. FData.free;
  689. FData:=nil;
  690. end;
  691. ObjRelocations.free;
  692. ObjRelocations:=nil;
  693. if assigned(FCachedFullName) then
  694. begin
  695. stringdispose(FCachedFullName);
  696. FCachedFullName:=nil;
  697. end;
  698. end;
  699. function TObjSection.FullName:string;
  700. begin
  701. if not assigned(FCachedFullName) then
  702. begin
  703. if assigned(ObjData) then
  704. FCachedFullName:=stringdup(ObjData.Name+'('+Name+')')
  705. else
  706. FCachedFullName:=stringdup(Name);
  707. end;
  708. result:=FCachedFullName^;
  709. end;
  710. {****************************************************************************
  711. TObjData
  712. ****************************************************************************}
  713. constructor TObjData.create(const n:string);
  714. begin
  715. inherited create;
  716. FName:=ExtractFileName(n);
  717. FObjSectionList:=TFPHashObjectList.Create(true);
  718. FStabsObjSec:=nil;
  719. FStabStrObjSec:=nil;
  720. { symbols }
  721. FObjSymbolList:=TFPHashObjectList.Create(true);
  722. FCachedAsmSymbolList:=TFPObjectList.Create(false);
  723. { section class type for creating of new sections }
  724. FCObjSection:=TObjSection;
  725. end;
  726. destructor TObjData.destroy;
  727. begin
  728. { Symbols }
  729. {$ifdef MEMDEBUG}
  730. MemObjSymbols.Start;
  731. {$endif}
  732. ResetCachedAsmSymbols;
  733. FCachedAsmSymbolList.free;
  734. FObjSymbolList.free;
  735. {$ifdef MEMDEBUG}
  736. MemObjSymbols.Stop;
  737. {$endif}
  738. { Sections }
  739. {$ifdef MEMDEBUG}
  740. MemObjSections.Start;
  741. {$endif}
  742. FObjSectionList.free;
  743. {$ifdef MEMDEBUG}
  744. MemObjSections.Stop;
  745. {$endif}
  746. inherited destroy;
  747. end;
  748. function TObjData.sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;
  749. const
  750. secnames : array[TAsmSectiontype] of string[length('__DATA, __datacoal_nt,coalesced')] = ('','',
  751. 'code',
  752. 'Data',
  753. 'Data',
  754. 'roData',
  755. 'bss',
  756. 'threadvar',
  757. 'pdata',
  758. 'stub',
  759. 'data_nonlazy',
  760. 'data_lazy',
  761. 'init_func',
  762. 'term_func',
  763. 'stab','stabstr',
  764. 'iData2','iData4','iData5','iData6','iData7','eData',
  765. 'eh_frame',
  766. 'debug_frame','debug_info','debug_line','debug_abbrev',
  767. 'fpc',
  768. 'toc',
  769. 'init',
  770. 'fini',
  771. 'objc_class',
  772. 'objc_meta_class',
  773. 'objc_cat_cls_meth',
  774. 'objc_cat_inst_meth',
  775. 'objc_protocol',
  776. 'objc_string_object',
  777. 'objc_cls_meth',
  778. 'objc_inst_meth',
  779. 'objc_cls_refs',
  780. 'objc_message_refs',
  781. 'objc_symbols',
  782. 'objc_category',
  783. 'objc_class_vars',
  784. 'objc_instance_vars',
  785. 'objc_module_info',
  786. 'objc_class_names',
  787. 'objc_meth_var_types',
  788. 'objc_meth_var_names',
  789. 'objc_selector_strs',
  790. 'objc_protocol_ext',
  791. 'objc_class_ext',
  792. 'objc_property',
  793. 'objc_image_info',
  794. 'objc_cstring_object',
  795. 'objc_sel_fixup',
  796. '__DATA,__objc_data',
  797. '__DATA,__objc_const',
  798. '.objc_superrefs',
  799. '__DATA, __datacoal_nt,coalesced',
  800. '.objc_classlist',
  801. '.objc_nlclasslist',
  802. '.objc_catlist',
  803. '.obcj_nlcatlist',
  804. '.objc_protolist'
  805. );
  806. var
  807. sep : string[3];
  808. begin
  809. if aname<>'' then
  810. begin
  811. case aorder of
  812. secorder_begin :
  813. sep:='.b_';
  814. secorder_end :
  815. sep:='.z_';
  816. else
  817. sep:='.n_';
  818. end;
  819. result:=secnames[atype]+sep+aname
  820. end
  821. else
  822. result:=secnames[atype];
  823. end;
  824. function TObjData.sectiontype2options(atype:TAsmSectiontype):TObjSectionOptions;
  825. const
  826. secoptions : array[TAsmSectiontype] of TObjSectionOptions = ([],
  827. {user} [oso_Data,oso_load,oso_write,oso_keep],
  828. {code} [oso_Data,oso_load,oso_executable,oso_keep],
  829. {Data} [oso_Data,oso_load,oso_write,oso_keep],
  830. { TODO: Fix sec_rodata be read-only-with-relocs}
  831. {roData} [oso_Data,oso_load,oso_write,oso_keep],
  832. { TODO: Fix sec_rodata_norel be read-only/constant}
  833. {roData_norel} [oso_Data,oso_load,oso_write,oso_keep],
  834. {bss} [oso_load,oso_write,oso_keep],
  835. {threadvar} [oso_load,oso_write
  836. {$ifdef FPC_USE_TLS_DIRECTORY}
  837. ,oso_keep
  838. {$endif FPC_USE_TLS_DIRECTORY}
  839. ],
  840. {pdata} [oso_data,oso_load {$ifndef x86_64},oso_keep{$endif}],
  841. {stub} [oso_Data,oso_load,oso_executable],
  842. {data_nonlazy} [oso_Data,oso_load,oso_write],
  843. {data_lazy} [oso_Data,oso_load,oso_write],
  844. {init_func} [oso_Data,oso_load],
  845. {term_func} [oso_Data,oso_load],
  846. {stab} [oso_Data,oso_debug],
  847. {stabstr} [oso_Data,oso_strings,oso_debug],
  848. {iData2} [oso_Data,oso_load,oso_write],
  849. {iData4} [oso_Data,oso_load,oso_write],
  850. {iData5} [oso_Data,oso_load,oso_write],
  851. {iData6} [oso_Data,oso_load,oso_write],
  852. {iData7} [oso_Data,oso_load,oso_write],
  853. {eData} [oso_Data,oso_load],
  854. {eh_frame} [oso_Data,oso_load],
  855. {debug_frame} [oso_Data,oso_debug],
  856. {debug_info} [oso_Data,oso_debug],
  857. {debug_line} [oso_Data,oso_debug],
  858. {debug_abbrev} [oso_Data,oso_debug],
  859. {fpc} [oso_Data,oso_load,oso_write,oso_keep],
  860. {toc} [oso_Data,oso_load],
  861. {init} [oso_Data,oso_load,oso_executable,oso_keep],
  862. {fini} [oso_Data,oso_load,oso_executable,oso_keep],
  863. {objc_class} [oso_data,oso_load],
  864. {objc_meta_class} [oso_data,oso_load],
  865. {objc_cat_cls_meth} [oso_data,oso_load],
  866. {objc_cat_inst_meth} [oso_data,oso_load],
  867. {objc_protocol} [oso_data,oso_load],
  868. {objc_string_object} [oso_data,oso_load],
  869. {objc_cls_meth} [oso_data,oso_load],
  870. {objc_inst_meth} [oso_data,oso_load],
  871. {objc_cls_refs} [oso_data,oso_load],
  872. {objc_message_refs} [oso_data,oso_load],
  873. {objc_symbols} [oso_data,oso_load],
  874. {objc_category} [oso_data,oso_load],
  875. {objc_class_vars} [oso_data,oso_load],
  876. {objc_instance_vars} [oso_data,oso_load],
  877. {objc_module_info} [oso_data,oso_load],
  878. {objc_class_names} [oso_data,oso_load],
  879. {objc_meth_var_types} [oso_data,oso_load],
  880. {objc_meth_var_names} [oso_data,oso_load],
  881. {objc_selector_strs} [oso_data,oso_load],
  882. {objc_protocol_ext} [oso_data,oso_load],
  883. {objc_class_ext} [oso_data,oso_load],
  884. {objc_property} [oso_data,oso_load],
  885. {objc_image_info} [oso_data,oso_load],
  886. {objc_cstring_object} [oso_data,oso_load],
  887. {objc_sel_fixup} [oso_data,oso_load],
  888. {sec_objc_data} [oso_data,oso_load],
  889. {sec_objc_const} [oso_data,oso_load],
  890. {sec_objc_sup_refs} [oso_data,oso_load],
  891. {sec_data_coalesced} [oso_data,oso_load],
  892. {sec_objc_classlist} [oso_data,oso_load],
  893. {sec_objc_nlclasslist} [oso_data,oso_load],
  894. {sec_objc_catlist} [oso_data,oso_load],
  895. {sec_objc_nlcatlist} [oso_data,oso_load],
  896. {sec_objc_protolist'} [oso_data,oso_load]
  897. );
  898. begin
  899. result:=secoptions[atype];
  900. end;
  901. function TObjData.sectiontype2align(atype:TAsmSectiontype):shortint;
  902. begin
  903. case atype of
  904. sec_stabstr,sec_debug_info,sec_debug_line,sec_debug_abbrev:
  905. result:=1;
  906. sec_code,
  907. sec_bss,
  908. sec_data:
  909. result:=16;
  910. { For idata (at least idata2) it must be 4 bytes, because
  911. an entry is always (also in win64) 20 bytes and aligning
  912. on 8 bytes will insert 4 bytes between the entries resulting
  913. in a corrupt idata section.
  914. Same story with .pdata, it has 4-byte elements which should
  915. be packed without gaps. }
  916. sec_idata2,sec_idata4,sec_idata5,sec_idata6,sec_idata7,sec_pdata:
  917. result:=4;
  918. else
  919. result:=sizeof(pint);
  920. end;
  921. end;
  922. function TObjData.createsection(atype:TAsmSectionType;const aname:string;aorder:TAsmSectionOrder):TObjSection;
  923. begin
  924. result:=createsection(sectionname(atype,aname,aorder),sectiontype2align(atype),sectiontype2options(atype));
  925. end;
  926. function TObjData.createsection(const aname:string;aalign:shortint;aoptions:TObjSectionOptions;DiscardDuplicate:boolean):TObjSection;
  927. begin
  928. if DiscardDuplicate then
  929. result:=TObjSection(FObjSectionList.Find(aname))
  930. else
  931. result:=nil;
  932. if not assigned(result) then
  933. begin
  934. result:=CObjSection.create(FObjSectionList,aname,aalign,aoptions);
  935. result.ObjData:=self;
  936. end;
  937. FCurrObjSec:=result;
  938. end;
  939. procedure TObjData.CreateDebugSections;
  940. begin
  941. end;
  942. function TObjData.FindSection(const aname:string):TObjSection;
  943. begin
  944. result:=TObjSection(FObjSectionList.Find(aname));
  945. end;
  946. procedure TObjData.setsection(asec:TObjSection);
  947. begin
  948. if asec.ObjData<>self then
  949. internalerror(200403041);
  950. FCurrObjSec:=asec;
  951. end;
  952. function TObjData.createsymbol(const aname:string):TObjSymbol;
  953. begin
  954. result:=TObjSymbol(FObjSymbolList.Find(aname));
  955. if not assigned(result) then
  956. result:=TObjSymbol.Create(FObjSymbolList,aname);
  957. end;
  958. function TObjData.symboldefine(asmsym:TAsmSymbol):TObjSymbol;
  959. begin
  960. if assigned(asmsym) then
  961. begin
  962. if not assigned(asmsym.cachedObjSymbol) then
  963. begin
  964. result:=symboldefine(asmsym.name,asmsym.bind,asmsym.typ);
  965. asmsym.cachedObjSymbol:=result;
  966. FCachedAsmSymbolList.add(asmsym);
  967. end
  968. else
  969. begin
  970. result:=TObjSymbol(asmsym.cachedObjSymbol);
  971. result.SetAddress(CurrPass,CurrObjSec,asmsym.bind,asmsym.typ);
  972. end;
  973. end
  974. else
  975. result:=nil;
  976. end;
  977. function TObjData.symboldefine(const aname:string;abind:TAsmsymbind;atyp:Tasmsymtype):TObjSymbol;
  978. begin
  979. if not assigned(CurrObjSec) then
  980. internalerror(200603051);
  981. result:=CreateSymbol(aname);
  982. result.SetAddress(CurrPass,CurrObjSec,abind,atyp);
  983. end;
  984. function TObjData.symbolref(asmsym:TAsmSymbol):TObjSymbol;
  985. var
  986. s:string;
  987. begin
  988. if assigned(asmsym) then
  989. begin
  990. if not assigned(asmsym.cachedObjSymbol) then
  991. begin
  992. s:=asmsym.name;
  993. result:=TObjSymbol(FObjSymbolList.Find(s));
  994. if result=nil then
  995. begin
  996. result:=TObjSymbol.Create(FObjSymbolList,s);
  997. if asmsym.bind=AB_WEAK_EXTERNAL then
  998. result.bind:=AB_WEAK_EXTERNAL;
  999. end;
  1000. asmsym.cachedObjSymbol:=result;
  1001. FCachedAsmSymbolList.add(asmsym);
  1002. end
  1003. else
  1004. result:=TObjSymbol(asmsym.cachedObjSymbol);
  1005. { The weak bit could have been removed from asmsym. }
  1006. if (asmsym.bind=AB_EXTERNAL) and (result.bind=AB_WEAK_EXTERNAL) then
  1007. result.bind:=AB_EXTERNAL;
  1008. end
  1009. else
  1010. result:=nil;
  1011. end;
  1012. function TObjData.symbolref(const aname:string):TObjSymbol;
  1013. begin
  1014. if not assigned(CurrObjSec) then
  1015. internalerror(200603052);
  1016. result:=CreateSymbol(aname);
  1017. end;
  1018. procedure TObjData.ResetCachedAsmSymbols;
  1019. var
  1020. i : longint;
  1021. begin
  1022. for i:=0 to FCachedAsmSymbolList.Count-1 do
  1023. tasmsymbol(FCachedAsmSymbolList[i]).cachedObjSymbol:=nil;
  1024. FCachedAsmSymbolList.Clear;
  1025. end;
  1026. procedure TObjData.writebytes(const Data;len:aword);
  1027. begin
  1028. if not assigned(CurrObjSec) then
  1029. internalerror(200402251);
  1030. CurrObjSec.write(Data,len);
  1031. end;
  1032. procedure TObjData.alloc(len:aword);
  1033. begin
  1034. if not assigned(CurrObjSec) then
  1035. internalerror(200402252);
  1036. CurrObjSec.alloc(len);
  1037. end;
  1038. procedure TObjData.allocalign(len:shortint);
  1039. begin
  1040. if not assigned(CurrObjSec) then
  1041. internalerror(200402253);
  1042. CurrObjSec.alloc(align(CurrObjSec.size,len)-CurrObjSec.size);
  1043. end;
  1044. procedure TObjData.section_afteralloc(p:TObject;arg:pointer);
  1045. begin
  1046. with TObjSection(p) do
  1047. alloc(align(size,secalign)-size);
  1048. end;
  1049. procedure TObjData.section_afterwrite(p:TObject;arg:pointer);
  1050. begin
  1051. with TObjSection(p) do
  1052. begin
  1053. if assigned(Data) then
  1054. writezeros(align(size,secalign)-size);
  1055. end;
  1056. end;
  1057. procedure TObjData.section_reset(p:TObject;arg:pointer);
  1058. begin
  1059. with TObjSection(p) do
  1060. begin
  1061. Size:=0;
  1062. Datapos:=0;
  1063. mempos:=0;
  1064. end;
  1065. end;
  1066. procedure TObjData.beforealloc;
  1067. begin
  1068. { create stabs sections if debugging }
  1069. if assigned(StabsSec) then
  1070. begin
  1071. StabsSec.Alloc(sizeof(TObjStabEntry));
  1072. StabStrSec.Alloc(1);
  1073. end;
  1074. end;
  1075. procedure TObjData.beforewrite;
  1076. var
  1077. s : string[1];
  1078. hstab : TObjStabEntry;
  1079. begin
  1080. { create stabs sections if debugging }
  1081. if assigned(StabsSec) then
  1082. begin
  1083. { Create dummy HdrSym stab, it will be overwritten in AfterWrite }
  1084. fillchar(hstab,sizeof(hstab),0);
  1085. StabsSec.Write(hstab,sizeof(hstab));
  1086. { start of stabstr }
  1087. s:=#0;
  1088. StabStrSec.write(s[1],length(s));
  1089. end;
  1090. end;
  1091. procedure TObjData.afteralloc;
  1092. begin
  1093. FObjSectionList.ForEachCall(@section_afteralloc,nil);
  1094. end;
  1095. procedure TObjData.afterwrite;
  1096. var
  1097. s : string[1];
  1098. hstab : TObjStabEntry;
  1099. begin
  1100. FObjSectionList.ForEachCall(@section_afterwrite,nil);
  1101. { For the stab section we need an HdrSym which can now be
  1102. calculated more easily }
  1103. if assigned(StabsSec) then
  1104. begin
  1105. { end of stabstr }
  1106. s:=#0;
  1107. StabStrSec.write(s[1],length(s));
  1108. { header stab }
  1109. hstab.strpos:=1;
  1110. hstab.ntype:=0;
  1111. hstab.nother:=0;
  1112. hstab.ndesc:=(StabsSec.Size div sizeof(TObjStabEntry))-1;
  1113. hstab.nvalue:=StabStrSec.Size;
  1114. StabsSec.Data.seek(0);
  1115. StabsSec.Data.write(hstab,sizeof(hstab));
  1116. end;
  1117. end;
  1118. procedure TObjData.resetsections;
  1119. begin
  1120. FObjSectionList.ForEachCall(@section_reset,nil);
  1121. end;
  1122. procedure TObjData.layoutsections(var DataPos:aword);
  1123. var
  1124. i: longint;
  1125. begin
  1126. for i:=0 to FObjSectionList.Count-1 do
  1127. TObjSection(FObjSectionList[i]).setDatapos(DataPos);
  1128. end;
  1129. {****************************************************************************
  1130. TObjOutput
  1131. ****************************************************************************}
  1132. constructor TObjOutput.create(AWriter:TObjectWriter);
  1133. begin
  1134. FWriter:=AWriter;
  1135. CObjData:=TObjData;
  1136. end;
  1137. destructor TObjOutput.destroy;
  1138. begin
  1139. inherited destroy;
  1140. end;
  1141. function TObjOutput.newObjData(const n:string):TObjData;
  1142. begin
  1143. result:=CObjData.create(n);
  1144. if (cs_use_lineinfo in current_settings.globalswitches) or
  1145. (cs_debuginfo in current_settings.moduleswitches) then
  1146. result.CreateDebugSections;
  1147. end;
  1148. function TObjOutput.startObjectfile(const fn:string):boolean;
  1149. begin
  1150. result:=false;
  1151. { start the writer already, so the .a generation can initialize
  1152. the position of the current objectfile }
  1153. if not FWriter.createfile(fn) then
  1154. Comment(V_Fatal,'Can''t create object '+fn);
  1155. result:=true;
  1156. end;
  1157. function TObjOutput.writeobjectfile(Data:TObjData):boolean;
  1158. begin
  1159. if errorcount=0 then
  1160. result:=writeData(Data)
  1161. else
  1162. result:=true;
  1163. { close the writer }
  1164. FWriter.closefile;
  1165. end;
  1166. procedure TObjOutput.exportsymbol(p:TObjSymbol);
  1167. begin
  1168. { export globals and common symbols, this is needed
  1169. for .a files }
  1170. if p.bind in [AB_GLOBAL,AB_COMMON] then
  1171. FWriter.writesym(p.name);
  1172. end;
  1173. procedure TObjOutput.WriteSectionContent(Data:TObjData);
  1174. var
  1175. i:longint;
  1176. sec:TObjSection;
  1177. begin
  1178. for i:=0 to Data.ObjSectionList.Count-1 do
  1179. begin
  1180. sec:=TObjSection(Data.ObjSectionList[i]);
  1181. if (oso_data in sec.SecOptions) then
  1182. begin
  1183. if sec.Data=nil then
  1184. internalerror(200403073);
  1185. FWriter.writezeros(sec.dataalignbytes);
  1186. if sec.Datapos<>FWriter.ObjSize then
  1187. internalerror(200604031);
  1188. FWriter.writearray(sec.data);
  1189. end;
  1190. end;
  1191. end;
  1192. {****************************************************************************
  1193. TExeVTable
  1194. ****************************************************************************}
  1195. constructor TExeVTable.Create(AExeSymbol:TExeSymbol);
  1196. begin
  1197. ExeSymbol:=AExeSymbol;
  1198. if ExeSymbol.State=symstate_undefined then
  1199. internalerror(200604012);
  1200. ChildList:=TFPObjectList.Create(false);
  1201. end;
  1202. destructor TExeVTable.Destroy;
  1203. begin
  1204. ChildList.Free;
  1205. if assigned(EntryArray) then
  1206. Freemem(EntryArray);
  1207. end;
  1208. procedure TExeVTable.CheckIdx(VTableIdx:longint);
  1209. var
  1210. OldEntryCnt : longint;
  1211. begin
  1212. if VTableIdx>=EntryCnt then
  1213. begin
  1214. OldEntryCnt:=EntryCnt;
  1215. EntryCnt:=VTableIdx+1;
  1216. ReAllocMem(EntryArray,EntryCnt*sizeof(TVTableEntry));
  1217. FillChar(EntryArray[OldEntryCnt],(EntryCnt-OldEntryCnt)*sizeof(TVTableEntry),0);
  1218. end;
  1219. end;
  1220. procedure TExeVTable.AddChild(vt:TExeVTable);
  1221. begin
  1222. ChildList.Add(vt);
  1223. end;
  1224. procedure TExeVTable.AddEntry(VTableIdx:Longint);
  1225. var
  1226. i : longint;
  1227. objreloc : TObjRelocation;
  1228. vtblentryoffset : aword;
  1229. begin
  1230. CheckIdx(VTableIdx);
  1231. vtblentryoffset:=ExeSymbol.ObjSymbol.Offset+longword(VTableIdx)*sizeof(pint);
  1232. { Find and disable relocation }
  1233. for i:=0 to ExeSymbol.ObjSymbol.ObjSection.ObjRelocations.Count-1 do
  1234. begin
  1235. objreloc:=TObjRelocation(ExeSymbol.ObjSymbol.ObjSection.ObjRelocations[i]);
  1236. if objreloc.dataoffset=vtblentryoffset then
  1237. begin
  1238. EntryArray[VTableIdx].ObjRelocation:=objreloc;
  1239. EntryArray[VTableIdx].OrgRelocType:=objreloc.typ;
  1240. objreloc.typ:=RELOC_ZERO;
  1241. break;
  1242. end;
  1243. end;
  1244. if not assigned(EntryArray[VTableIdx].ObjRelocation) then
  1245. internalerror(200604011);
  1246. end;
  1247. procedure TExeVTable.SetVTableSize(ASize:longint);
  1248. begin
  1249. if EntryCnt<>0 then
  1250. internalerror(200603313);
  1251. EntryCnt:=ASize div sizeof(pint);
  1252. EntryArray:=AllocMem(EntryCnt*sizeof(TVTableEntry));
  1253. end;
  1254. function TExeVTable.VTableRef(VTableIdx:Longint):TObjRelocation;
  1255. begin
  1256. result:=nil;
  1257. CheckIdx(VTableIdx);
  1258. if EntryArray[VTableIdx].Used then
  1259. exit;
  1260. { Restore relocation if available }
  1261. if assigned(EntryArray[VTableIdx].ObjRelocation) then
  1262. begin
  1263. EntryArray[VTableIdx].ObjRelocation.typ:=EntryArray[VTableIdx].OrgRelocType;
  1264. result:=EntryArray[VTableIdx].ObjRelocation;
  1265. end;
  1266. EntryArray[VTableIdx].Used:=true;
  1267. end;
  1268. {****************************************************************************
  1269. TExeSection
  1270. ****************************************************************************}
  1271. constructor TExeSection.create(AList:TFPHashObjectList;const AName:string);
  1272. begin
  1273. inherited create(AList,AName);
  1274. Size:=0;
  1275. MemPos:=0;
  1276. DataPos:=0;
  1277. FSecSymIdx:=0;
  1278. FObjSectionList:=TFPObjectList.Create(false);
  1279. end;
  1280. destructor TExeSection.destroy;
  1281. begin
  1282. ObjSectionList.Free;
  1283. inherited destroy;
  1284. end;
  1285. procedure TExeSection.AddObjSection(objsec:TObjSection);
  1286. begin
  1287. ObjSectionList.Add(objsec);
  1288. if (SecOptions<>[]) then
  1289. begin
  1290. { Only if the section contains (un)initialized data the
  1291. data flag must match. This check is not needed if the
  1292. section is empty for a symbol allocation }
  1293. if (objsec.size>0) and
  1294. ((oso_Data in SecOptions)<>(oso_Data in objsec.SecOptions)) then
  1295. Comment(V_Error,'Incompatible section options');
  1296. end
  1297. else
  1298. begin
  1299. { inherit section options }
  1300. SecOptions:=SecOptions+objsec.SecOptions;
  1301. end;
  1302. { relate ObjSection to ExeSection, and mark it Used by default }
  1303. SecAlign:=max(objsec.SecAlign,SecAlign);
  1304. objsec.ExeSection:=self;
  1305. objsec.Used:=true;
  1306. end;
  1307. {****************************************************************************
  1308. TStaticLibrary
  1309. ****************************************************************************}
  1310. constructor TStaticLibrary.create(const AName:TCmdStr;AReader:TObjectReader;AObjInputClass:TObjInputClass);
  1311. begin
  1312. FName:=AName;
  1313. FArReader:=AReader;
  1314. FObjInputClass:=AObjInputClass;
  1315. end;
  1316. destructor TStaticLibrary.destroy;
  1317. begin
  1318. ArReader.Free;
  1319. inherited destroy;
  1320. end;
  1321. {****************************************************************************
  1322. TImportLibrary
  1323. ****************************************************************************}
  1324. constructor TImportLibrary.create(AList:TFPHashObjectList;const AName:string);
  1325. begin
  1326. inherited create(AList,AName);
  1327. FImportSymbolList:=TFPHashObjectList.Create(true);
  1328. end;
  1329. destructor TImportLibrary.destroy;
  1330. begin
  1331. ImportSymbolList.Free;
  1332. inherited destroy;
  1333. end;
  1334. {****************************************************************************
  1335. TImportSymbol
  1336. ****************************************************************************}
  1337. constructor TImportSymbol.create(AList:TFPHashObjectList;
  1338. const AName,AMangledName:string;AOrdNr:longint;AIsVar:boolean);
  1339. begin
  1340. inherited Create(AList, AName);
  1341. FOrdNr:=AOrdNr;
  1342. FIsVar:=AIsVar;
  1343. FMangledName:=AMangledName;
  1344. { Replace ? and @ in import name, since GNU AS does not allow these characters in symbol names. }
  1345. { This allows to import VC++ mangled names from DLLs. }
  1346. if target_info.system in systems_all_windows then
  1347. begin
  1348. Replace(FMangledName,'?','__q$$');
  1349. {$ifdef arm}
  1350. { @ symbol is not allowed in ARM assembler only }
  1351. Replace(FMangledName,'@','__a$$');
  1352. {$endif arm}
  1353. end;
  1354. end;
  1355. {****************************************************************************
  1356. TExeOutput
  1357. ****************************************************************************}
  1358. constructor TExeOutput.create;
  1359. begin
  1360. { init writer }
  1361. FWriter:=TObjectwriter.create;
  1362. FExeWriteMode:=ewm_exefull;
  1363. { object files }
  1364. FObjDataList:=TFPObjectList.Create(true);
  1365. { symbols }
  1366. FExeSymbolList:=TFPHashObjectList.Create(true);
  1367. FUnresolvedExeSymbols:=TFPObjectList.Create(false);
  1368. FExternalObjSymbols:=TFPObjectList.Create(false);
  1369. FCommonObjSymbols:=TFPObjectList.Create(false);
  1370. FProvidedObjSymbols:=TFPObjectList.Create(false);
  1371. FExeVTableList:=TFPObjectList.Create(false);
  1372. { sections }
  1373. FExeSectionList:=TFPHashObjectList.Create(true);
  1374. FImageBase:=0;
  1375. {$ifdef cpu16bitaddr}
  1376. SectionMemAlign:=$10;
  1377. SectionDataAlign:=$10;
  1378. {$else cpu16bitaddr}
  1379. SectionMemAlign:=$1000;
  1380. SectionDataAlign:=$200;
  1381. {$endif cpu16bitaddr}
  1382. FCExeSection:=TExeSection;
  1383. FCObjData:=TObjData;
  1384. end;
  1385. destructor TExeOutput.destroy;
  1386. begin
  1387. FExeSymbolList.free;
  1388. UnresolvedExeSymbols.free;
  1389. ExternalObjSymbols.free;
  1390. FProvidedObjSymbols.free;
  1391. CommonObjSymbols.free;
  1392. ExeVTableList.free;
  1393. FExeSectionList.free;
  1394. ObjDatalist.free;
  1395. FWriter.free;
  1396. inherited destroy;
  1397. end;
  1398. function TExeOutput.WriteExeFile(const fn:string):boolean;
  1399. begin
  1400. result:=false;
  1401. if FWriter.createfile(fn) then
  1402. begin
  1403. { Only write the .o if there are no errors }
  1404. if errorcount=0 then
  1405. result:=writedata
  1406. else
  1407. result:=true;
  1408. { close the writer }
  1409. FWriter.closefile;
  1410. end
  1411. else
  1412. Comment(V_Fatal,'Can''t create executable '+fn);
  1413. end;
  1414. procedure TExeOutput.ParseScript (linkscript:TCmdStrList);
  1415. begin
  1416. end;
  1417. function TExeOutput.FindExeSection(const aname:string):TExeSection;
  1418. begin
  1419. result:=TExeSection(ExeSectionList.Find(aname));
  1420. end;
  1421. procedure TExeOutput.AddObjData(ObjData:TObjData);
  1422. begin
  1423. if ObjData.classtype<>FCObjData then
  1424. Comment(V_Error,'Invalid input object format for '+ObjData.name+' got '+ObjData.classname+' expected '+FCObjData.classname);
  1425. ObjDataList.Add(ObjData);
  1426. ExecStack:=ExecStack or ObjData.ExecStack;
  1427. end;
  1428. procedure TExeOutput.Load_Start;
  1429. begin
  1430. ObjDataList.Clear;
  1431. { Globals defined in the linker script }
  1432. if not assigned(internalObjData) then
  1433. internalObjData:=CObjData.create('*Internal*');
  1434. AddObjData(internalObjData);
  1435. { Common Data section }
  1436. commonObjSection:=internalObjData.createsection(sec_bss,'');
  1437. { setting SecOptions acts as 'include' }
  1438. commonObjSection.SecOptions:=[oso_common];
  1439. end;
  1440. procedure TExeOutput.Load_EntryName(const aname:string);
  1441. begin
  1442. FEntryName:=aname;
  1443. end;
  1444. procedure TExeOutput.Load_IsSharedLibrary;
  1445. begin
  1446. IsSharedLibrary:=true;
  1447. end;
  1448. procedure TExeOutput.Load_ImageBase(const avalue:string);
  1449. var
  1450. code : integer;
  1451. objsec : TObjSection;
  1452. objsym : TObjSymbol;
  1453. exesym : TExeSymbol;
  1454. begin
  1455. val(avalue,FImageBase,code);
  1456. if code<>0 then
  1457. Comment(V_Error,'Invalid number '+avalue);
  1458. { Create __image_base__ symbol, create the symbol
  1459. in a section with adress 0 and at offset 0 }
  1460. objsec:=internalObjData.createsection('*__image_base__',0,[]);
  1461. internalObjData.setsection(objsec);
  1462. objsym:=internalObjData.SymbolDefine('__image_base__',AB_GLOBAL,AT_DATA);
  1463. exesym:=texesymbol.Create(FExeSymbolList,objsym.name);
  1464. exesym.ObjSymbol:=objsym;
  1465. end;
  1466. procedure TExeOutput.Load_Symbol(const aname:string);
  1467. begin
  1468. internalObjData.createsection('*'+aname,0,[]);
  1469. internalObjData.SymbolDefine(aname,AB_GLOBAL,AT_DATA);
  1470. end;
  1471. procedure TExeOutput.Load_ProvideSymbol(const aname:string);
  1472. begin
  1473. if assigned(ExeSymbolList.Find(aname)) then
  1474. exit;
  1475. internalObjData.createsection('*'+aname,0,[]);
  1476. // Use AB_COMMON to avoid muliple defined complaints
  1477. internalObjData.SymbolDefine(aname,AB_COMMON,AT_DATA);
  1478. end;
  1479. procedure TExeOutput.Load_DynamicObject(ObjData:TObjData);
  1480. begin
  1481. end;
  1482. procedure TExeOutput.Order_Start;
  1483. begin
  1484. end;
  1485. procedure TExeOutput.Order_End;
  1486. begin
  1487. internalObjData.afterwrite;
  1488. end;
  1489. procedure TExeOutput.Order_ExeSection(const aname:string);
  1490. var
  1491. sec : TExeSection;
  1492. begin
  1493. sec:=FindExeSection(aname);
  1494. if not assigned(sec) then
  1495. sec:=CExeSection.create(ExeSectionList,aname);
  1496. { Clear ExeSection contents }
  1497. FCurrExeSec:=sec;
  1498. end;
  1499. procedure TExeOutput.Order_EndExeSection;
  1500. begin
  1501. if not assigned(CurrExeSec) then
  1502. internalerror(200602184);
  1503. FCurrExeSec:=nil;
  1504. end;
  1505. procedure TExeOutput.Order_ObjSection(const aname:string);
  1506. var
  1507. i,j : longint;
  1508. ObjData : TObjData;
  1509. objsec : TObjSection;
  1510. TmpObjSectionList : TFPObjectList;
  1511. begin
  1512. if not assigned(CurrExeSec) then
  1513. internalerror(200602181);
  1514. TmpObjSectionList:=TFPObjectList.Create(false);
  1515. for i:=0 to ObjDataList.Count-1 do
  1516. begin
  1517. ObjData:=TObjData(ObjDataList[i]);
  1518. for j:=0 to ObjData.ObjSectionList.Count-1 do
  1519. begin
  1520. objsec:=TObjSection(ObjData.ObjSectionList[j]);
  1521. if (not objsec.Used) and
  1522. MatchPattern(aname,objsec.name) then
  1523. TmpObjSectionList.Add(objsec);
  1524. end;
  1525. end;
  1526. { Order list if needed }
  1527. Order_ObjSectionList(TmpObjSectionList,aname);
  1528. { Add the (ordered) list to the current ExeSection }
  1529. for i:=0 to TmpObjSectionList.Count-1 do
  1530. begin
  1531. objsec:=TObjSection(TmpObjSectionList[i]);
  1532. CurrExeSec.AddObjSection(objsec);
  1533. end;
  1534. TmpObjSectionList.Free;
  1535. end;
  1536. procedure TExeOutput.Order_ObjSectionList(ObjSectionList : TFPObjectList; const aPattern:string);
  1537. begin
  1538. end;
  1539. procedure TExeOutput.Order_Symbol(const aname:string);
  1540. var
  1541. ObjSection : TObjSection;
  1542. begin
  1543. ObjSection:=internalObjData.findsection('*'+aname);
  1544. if not assigned(ObjSection) then
  1545. internalerror(200603041);
  1546. CurrExeSec.AddObjSection(ObjSection);
  1547. end;
  1548. procedure TExeOutput.Order_ProvideSymbol(const aname:string);
  1549. var
  1550. ObjSection : TObjSection;
  1551. exesym : TExeSymbol;
  1552. begin
  1553. ObjSection:=internalObjData.findsection('*'+aname);
  1554. if not assigned(ObjSection) then
  1555. internalerror(200603041);
  1556. exesym:=TExeSymbol(ExeSymbolList.Find(aname));
  1557. if not assigned(exesym) then
  1558. internalerror(201206301);
  1559. { Only include this section if it actually resolves
  1560. the symbol }
  1561. if exesym.objsymbol.objsection=objsection then
  1562. CurrExeSec.AddObjSection(ObjSection);
  1563. end;
  1564. procedure TExeOutput.Order_Align(const avalue:string);
  1565. var
  1566. code : integer;
  1567. alignval : shortint;
  1568. objsec : TObjSection;
  1569. begin
  1570. val(avalue,alignval,code);
  1571. if code<>0 then
  1572. Comment(V_Error,'Invalid number '+avalue);
  1573. if alignval<=0 then
  1574. exit;
  1575. { Create an empty section with the required aligning }
  1576. inc(Fzeronr);
  1577. objsec:=internalObjData.createsection('*align'+tostr(Fzeronr),alignval,CurrExeSec.SecOptions+[oso_Data,oso_keep]);
  1578. CurrExeSec.AddObjSection(objsec);
  1579. end;
  1580. procedure TExeOutput.Order_Zeros(const avalue:string);
  1581. var
  1582. zeros : array[0..1023] of byte;
  1583. code : integer;
  1584. len : longint;
  1585. objsec : TObjSection;
  1586. begin
  1587. val(avalue,len,code);
  1588. if code<>0 then
  1589. Comment(V_Error,'Invalid number '+avalue);
  1590. if len<=0 then
  1591. exit;
  1592. if len>sizeof(zeros) then
  1593. internalerror(200602254);
  1594. fillchar(zeros,len,0);
  1595. inc(Fzeronr);
  1596. objsec:=internalObjData.createsection('*zeros'+tostr(Fzeronr),0,CurrExeSec.SecOptions+[oso_Data,oso_keep]);
  1597. internalObjData.writebytes(zeros,len);
  1598. CurrExeSec.AddObjSection(objsec);
  1599. end;
  1600. procedure TExeOutput.Order_Values(bytesize : aword; const avalue:string);
  1601. const
  1602. MAXVAL = 128;
  1603. var
  1604. bytevalues : array[0..MAXVAL-1] of byte;
  1605. twobytevalues : array[0..MAXVAL-1] of word;
  1606. fourbytevalues : array[0..MAXVAL-1] of dword;
  1607. eightbytevalues : array[0..MAXVAL-1] of qword;
  1608. allvals, oneval : string;
  1609. len, commapos : longint;
  1610. indexpos, code : integer;
  1611. anumval : qword;
  1612. signedval : int64;
  1613. objsec : TObjSection;
  1614. begin
  1615. indexpos:=0;
  1616. allvals:=avalue;
  1617. repeat
  1618. commapos:=pos(',',allvals);
  1619. if commapos>0 then
  1620. begin
  1621. oneval:=trim(copy(allvals,1,commapos-1));
  1622. allvals:=copy(allvals,commapos+1,length(allvals));
  1623. end
  1624. else
  1625. begin
  1626. oneval:=trim(allvals);
  1627. allvals:='';
  1628. end;
  1629. if oneval<>'' then
  1630. begin
  1631. if oneval[1]='-' then
  1632. begin
  1633. val(oneval,signedval,code);
  1634. anumval:=qword(signedval);
  1635. end
  1636. else
  1637. val(oneval,anumval,code);
  1638. if code<>0 then
  1639. Comment(V_Error,'Invalid number '+avalue)
  1640. else
  1641. begin
  1642. if (indexpos<MAXVAL) then
  1643. begin
  1644. if source_info.endian<>target_info.endian then
  1645. swapendian(anumval);
  1646. { No range checking here }
  1647. if bytesize=1 then
  1648. bytevalues[indexpos]:=byte(anumval)
  1649. else if bytesize=2 then
  1650. twobytevalues[indexpos]:=word(anumval)
  1651. else if bytesize=4 then
  1652. fourbytevalues[indexpos]:=dword(anumval)
  1653. else if bytesize=8 then
  1654. eightbytevalues[indexpos]:=anumval;
  1655. inc(indexpos);
  1656. end
  1657. else
  1658. Comment(V_Error,'Buffer overrun in Order_values');
  1659. end;
  1660. end;
  1661. until allvals='';
  1662. if indexpos=0 then
  1663. begin
  1664. Comment(V_Error,'Invalid number '+avalue);
  1665. exit;
  1666. end;
  1667. if indexpos=MAXVAL then
  1668. begin
  1669. Comment(V_Error,'Too many values '+avalue);
  1670. internalerror(200602254);
  1671. end;
  1672. len:=bytesize*indexpos;
  1673. inc(Fvaluesnr);
  1674. objsec:=internalObjData.createsection('*values'+tostr(Fvaluesnr),0,CurrExeSec.SecOptions+[oso_Data,oso_keep]);
  1675. if bytesize=1 then
  1676. internalObjData.writebytes(bytevalues,len)
  1677. else if bytesize=2 then
  1678. internalObjData.writebytes(twobytevalues,len)
  1679. else if bytesize=4 then
  1680. internalObjData.writebytes(fourbytevalues,len)
  1681. else if bytesize=8 then
  1682. internalObjData.writebytes(eightbytevalues,len);
  1683. CurrExeSec.AddObjSection(objsec);
  1684. end;
  1685. procedure TExeOutput.MemPos_Start;
  1686. begin
  1687. CurrMemPos:=0;
  1688. RemoveDisabledSections;
  1689. end;
  1690. procedure TExeOutput.MemPos_Header;
  1691. begin
  1692. end;
  1693. procedure TExeOutput.MemPos_ExeSection(exesec:TExeSection);
  1694. var
  1695. i : longint;
  1696. objsec : TObjSection;
  1697. begin
  1698. { Alignment of ExeSection }
  1699. CurrMemPos:=align(CurrMemPos,SectionMemAlign);
  1700. exesec.MemPos:=CurrMemPos;
  1701. { set position of object ObjSections }
  1702. for i:=0 to exesec.ObjSectionList.Count-1 do
  1703. begin
  1704. objsec:=TObjSection(exesec.ObjSectionList[i]);
  1705. CurrMemPos:=objsec.setmempos(CurrMemPos);
  1706. end;
  1707. { calculate size of the section }
  1708. exesec.Size:=CurrMemPos-exesec.MemPos;
  1709. end;
  1710. procedure TExeOutput.MemPos_ExeSection(const aname:string);
  1711. begin
  1712. { Section can be removed }
  1713. FCurrExeSec:=FindExeSection(aname);
  1714. if not assigned(CurrExeSec) then
  1715. exit;
  1716. MemPos_ExeSection(CurrExeSec);
  1717. end;
  1718. procedure TExeOutput.MemPos_EndExeSection;
  1719. begin
  1720. if not assigned(CurrExeSec) then
  1721. exit;
  1722. FCurrExeSec:=nil;
  1723. end;
  1724. procedure TExeOutput.DataPos_Start;
  1725. begin
  1726. end;
  1727. procedure TExeOutput.DataPos_Header;
  1728. begin
  1729. end;
  1730. procedure TExeOutput.DataPos_ExeSection(exesec:TExeSection);
  1731. var
  1732. i : longint;
  1733. objsec : TObjSection;
  1734. begin
  1735. { don't write normal section if writing only debug info }
  1736. if (ExeWriteMode=ewm_dbgonly) and
  1737. not(oso_debug in exesec.SecOptions) then
  1738. exit;
  1739. if (oso_Data in exesec.SecOptions) then
  1740. begin
  1741. CurrDataPos:=align(CurrDataPos,SectionDataAlign);
  1742. exesec.DataPos:=CurrDataPos;
  1743. end;
  1744. { set position of object ObjSections }
  1745. for i:=0 to exesec.ObjSectionList.Count-1 do
  1746. begin
  1747. objsec:=TObjSection(exesec.ObjSectionList[i]);
  1748. if (oso_Data in objsec.SecOptions) then
  1749. begin
  1750. if not(oso_Data in exesec.SecOptions) then
  1751. internalerror(200603043);
  1752. if not assigned(objsec.Data) then
  1753. internalerror(200603044);
  1754. objsec.setDatapos(CurrDataPos);
  1755. end;
  1756. end;
  1757. end;
  1758. procedure TExeOutput.DataPos_ExeSection(const aname:string);
  1759. begin
  1760. { Section can be removed }
  1761. FCurrExeSec:=FindExeSection(aname);
  1762. if not assigned(CurrExeSec) then
  1763. exit;
  1764. DataPos_ExeSection(CurrExeSec);
  1765. end;
  1766. procedure TExeOutput.DataPos_EndExeSection;
  1767. begin
  1768. if not assigned(CurrExeSec) then
  1769. exit;
  1770. FCurrExeSec:=nil;
  1771. end;
  1772. procedure TExeOutput.DataPos_Symbols;
  1773. begin
  1774. end;
  1775. procedure TExeOutput.BuildVTableTree(VTInheritList,VTEntryList:TFPObjectList);
  1776. var
  1777. hs : string;
  1778. code : integer;
  1779. i,k,
  1780. vtableidx : longint;
  1781. vtableexesym,
  1782. childexesym,
  1783. parentexesym : TExeSymbol;
  1784. objsym : TObjSymbol;
  1785. begin
  1786. { Build inheritance tree from VTINHERIT }
  1787. for i:=0 to VTInheritList.Count-1 do
  1788. begin
  1789. objsym:=TObjSymbol(VTInheritList[i]);
  1790. hs:=objsym.name;
  1791. { VTINHERIT_<ChildVMTName>$$<ParentVMTName> }
  1792. Delete(hs,1,Pos('_',hs));
  1793. k:=Pos('$$',hs);
  1794. if k=0 then
  1795. internalerror(200603311);
  1796. childexesym:=texesymbol(FExeSymbolList.Find(Copy(hs,1,k-1)));
  1797. parentexesym:=texesymbol(FExeSymbolList.Find(Copy(hs,k+2,length(hs)-k-1)));
  1798. if not assigned(childexesym) or
  1799. not assigned(parentexesym)then
  1800. internalerror(200603312);
  1801. if not assigned(childexesym.vtable) then
  1802. begin
  1803. childexesym.vtable:=TExeVTable.Create(childexesym);
  1804. ExeVTableList.Add(childexesym.vtable);
  1805. end;
  1806. if not assigned(parentexesym.vtable) then
  1807. begin
  1808. parentexesym.vtable:=TExeVTable.Create(parentexesym);
  1809. ExeVTableList.Add(parentexesym.vtable);
  1810. end;
  1811. childexesym.vtable.SetVTableSize(childexesym.ObjSymbol.Size);
  1812. if parentexesym<>childexesym then
  1813. parentexesym.vtable.AddChild(childexesym.vtable);
  1814. end;
  1815. { Find VTable entries from VTENTRY }
  1816. for i:=0 to VTEntryList.Count-1 do
  1817. begin
  1818. objsym:=TObjSymbol(VTEntryList[i]);
  1819. hs:=objsym.name;
  1820. { VTENTRY_<VTableName>$$<Index> }
  1821. Delete(hs,1,Pos('_',hs));
  1822. k:=Pos('$$',hs);
  1823. if k=0 then
  1824. internalerror(200603319);
  1825. vtableexesym:=texesymbol(FExeSymbolList.Find(Copy(hs,1,k-1)));
  1826. val(Copy(hs,k+2,length(hs)-k-1),vtableidx,code);
  1827. if (code<>0) then
  1828. internalerror(200603318);
  1829. if not assigned(vtableexesym) then
  1830. internalerror(2006033110);
  1831. vtableexesym.vtable.AddEntry(vtableidx);
  1832. end;
  1833. end;
  1834. procedure TExeOutput.PackUnresolvedExeSymbols(const s:string);
  1835. var
  1836. i : longint;
  1837. exesym : TExeSymbol;
  1838. begin
  1839. { Generate a list of Unresolved External symbols }
  1840. for i:=0 to UnresolvedExeSymbols.count-1 do
  1841. begin
  1842. exesym:=TExeSymbol(UnresolvedExeSymbols[i]);
  1843. if exesym.State<>symstate_undefined then
  1844. UnresolvedExeSymbols[i]:=nil;
  1845. end;
  1846. UnresolvedExeSymbols.Pack;
  1847. Comment(V_Debug,'Number of unresolved externals '+s+' '+tostr(UnresolvedExeSymbols.Count));
  1848. end;
  1849. procedure TExeOutput.ResolveSymbols(StaticLibraryList:TFPObjectList);
  1850. var
  1851. ObjData : TObjData;
  1852. exesym : TExeSymbol;
  1853. objsym,
  1854. commonsym : TObjSymbol;
  1855. objinput : TObjInput;
  1856. StaticLibrary : TStaticLibrary;
  1857. firstarchive,
  1858. firstcommon : boolean;
  1859. i,j : longint;
  1860. VTEntryList,
  1861. VTInheritList : TFPObjectList;
  1862. procedure LoadObjDataSymbols(ObjData:TObjData);
  1863. var
  1864. j : longint;
  1865. hs : string;
  1866. exesym : TExeSymbol;
  1867. objsym : TObjSymbol;
  1868. begin
  1869. for j:=0 to ObjData.ObjSymbolList.Count-1 do
  1870. begin
  1871. objsym:=TObjSymbol(ObjData.ObjSymbolList[j]);
  1872. { From the local symbols we are only interressed in the
  1873. VTENTRY and VTINHERIT symbols }
  1874. if objsym.bind=AB_LOCAL then
  1875. begin
  1876. if cs_link_opt_vtable in current_settings.globalswitches then
  1877. begin
  1878. hs:=objsym.name;
  1879. if (hs[1]='V') then
  1880. begin
  1881. if Copy(hs,1,5)='VTREF' then
  1882. begin
  1883. if not assigned(objsym.ObjSection.VTRefList) then
  1884. objsym.ObjSection.VTRefList:=TFPObjectList.Create(false);
  1885. objsym.ObjSection.VTRefList.Add(objsym);
  1886. end
  1887. else if Copy(hs,1,7)='VTENTRY' then
  1888. VTEntryList.Add(objsym)
  1889. else if Copy(hs,1,9)='VTINHERIT' then
  1890. VTInheritList.Add(objsym);
  1891. end;
  1892. end;
  1893. continue;
  1894. end;
  1895. { Search for existing exesymbol }
  1896. exesym:=texesymbol(FExeSymbolList.Find(objsym.name));
  1897. if not assigned(exesym) then
  1898. begin
  1899. exesym:=texesymbol.Create(FExeSymbolList,objsym.name);
  1900. exesym.ObjSymbol:=objsym;
  1901. end;
  1902. objsym.ExeSymbol:=exesym;
  1903. case objsym.bind of
  1904. AB_GLOBAL :
  1905. begin
  1906. if exesym.State<>symstate_defined then
  1907. begin
  1908. exesym.ObjSymbol:=objsym;
  1909. exesym.State:=symstate_defined;
  1910. end
  1911. else
  1912. Comment(V_Error,'Multiple defined symbol '+objsym.name);
  1913. end;
  1914. AB_EXTERNAL :
  1915. begin
  1916. ExternalObjSymbols.add(objsym);
  1917. { Register unresolved symbols only the first time they
  1918. are registered }
  1919. if exesym.ObjSymbol=objsym then
  1920. UnresolvedExeSymbols.Add(exesym);
  1921. end;
  1922. AB_COMMON :
  1923. begin
  1924. if exesym.State=symstate_undefined then
  1925. begin
  1926. exesym.ObjSymbol:=objsym;
  1927. exesym.State:=symstate_common;
  1928. end;
  1929. if assigned(objsym.objsection) and
  1930. (objsym.objsection.objdata=internalObjData) then
  1931. FProvidedObjSymbols.add(objsym)
  1932. else
  1933. CommonObjSymbols.add(objsym);
  1934. end;
  1935. end;
  1936. end;
  1937. end;
  1938. begin
  1939. VTEntryList:=TFPObjectList.Create(false);
  1940. VTInheritList:=TFPObjectList.Create(false);
  1941. {
  1942. The symbol resolving is done in 4 steps:
  1943. 1. Register symbols from objects
  1944. 2. Find symbols in static libraries
  1945. 3. Define symbols PROVIDEd by the link script
  1946. 4. Define still undefined common symbols
  1947. }
  1948. { Step 1, Register symbols from objects }
  1949. for i:=0 to ObjDataList.Count-1 do
  1950. begin
  1951. ObjData:=TObjData(ObjDataList[i]);
  1952. LoadObjDataSymbols(ObjData);
  1953. end;
  1954. PackUnresolvedExeSymbols('in objects');
  1955. { Step 2, Find unresolved symbols in the libraries }
  1956. firstarchive:=true;
  1957. for i:=0 to StaticLibraryList.Count-1 do
  1958. begin
  1959. StaticLibrary:=TStaticLibrary(StaticLibraryList[i]);
  1960. { Process list of Unresolved External symbols, we need
  1961. to use a while loop because the list can be extended when
  1962. we load members from the library. }
  1963. j:=0;
  1964. while (j<UnresolvedExeSymbols.count) do
  1965. begin
  1966. exesym:=TExeSymbol(UnresolvedExeSymbols[j]);
  1967. { Check first if the symbol is still undefined }
  1968. if exesym.State=symstate_undefined then
  1969. begin
  1970. if StaticLibrary.ArReader.OpenFile(exesym.name) then
  1971. begin
  1972. if assigned(exemap) then
  1973. begin
  1974. if firstarchive then
  1975. begin
  1976. exemap.Add('');
  1977. exemap.Add('Archive member included because of file (symbol)');
  1978. exemap.Add('');
  1979. firstarchive:=false;
  1980. end;
  1981. exemap.Add(StaticLibrary.ArReader.FileName+' - '+
  1982. {exesym.ObjSymbol.ObjSection.FullName+}
  1983. '('+exesym.Name+')');
  1984. end;
  1985. objinput:=StaticLibrary.ObjInputClass.Create;
  1986. objdata:=objinput.newObjData(StaticLibrary.ArReader.FileName);
  1987. objinput.ReadObjData(StaticLibrary.ArReader,objdata);
  1988. objinput.free;
  1989. AddObjData(objdata);
  1990. LoadObjDataSymbols(objdata);
  1991. StaticLibrary.ArReader.CloseFile;
  1992. end;
  1993. end;
  1994. inc(j);
  1995. end;
  1996. end;
  1997. PackUnresolvedExeSymbols('after static libraries');
  1998. { Step 3, handle symbols provided in script }
  1999. for i:=0 to FProvidedObjSymbols.count-1 do
  2000. begin
  2001. objsym:=TObjSymbol(FProvidedObjSymbols[i]);
  2002. if objsym.exesymbol.State=symstate_defined then
  2003. continue;
  2004. objsym.exesymbol.objsymbol:=objsym;
  2005. objsym.bind:=AB_GLOBAL;
  2006. objsym.exesymbol.State:=symstate_defined;
  2007. end;
  2008. PackUnresolvedExeSymbols('after defining symbols provided by link script');
  2009. { Step 4, Match common symbols or add to the globals }
  2010. firstcommon:=true;
  2011. for i:=0 to CommonObjSymbols.count-1 do
  2012. begin
  2013. objsym:=TObjSymbol(CommonObjSymbols[i]);
  2014. if objsym.exesymbol.State=symstate_defined then
  2015. begin
  2016. if objsym.exesymbol.ObjSymbol.size<>objsym.size then
  2017. Comment(V_Debug,'Size of common symbol '+objsym.name+' is different, expected '+tostr(objsym.size)+' got '+tostr(objsym.exesymbol.ObjSymbol.size));
  2018. end
  2019. else
  2020. begin
  2021. { allocate new objsymbol in .bss of *COMMON* and assign
  2022. it to the exesymbol }
  2023. if firstcommon then
  2024. begin
  2025. if assigned(exemap) then
  2026. exemap.AddCommonSymbolsHeader;
  2027. firstcommon:=false;
  2028. end;
  2029. internalObjData.setsection(commonObjSection);
  2030. internalObjData.allocalign(var_align(objsym.size));
  2031. commonsym:=internalObjData.symboldefine(objsym.name,AB_GLOBAL,AT_DATA);
  2032. commonsym.size:=objsym.size;
  2033. internalObjData.alloc(objsym.size);
  2034. if assigned(exemap) then
  2035. exemap.AddCommonSymbol(commonsym);
  2036. { Assign to the exesymbol }
  2037. objsym.exesymbol.objsymbol:=commonsym;
  2038. objsym.exesymbol.state:=symstate_defined;
  2039. end;
  2040. end;
  2041. PackUnresolvedExeSymbols('after defining COMMON symbols');
  2042. { Find entry symbol and print in map }
  2043. if (EntryName<>'') then
  2044. begin
  2045. exesym:=texesymbol(ExeSymbolList.Find(EntryName));
  2046. if assigned(exesym) then
  2047. begin
  2048. EntrySym:=exesym.ObjSymbol;
  2049. if assigned(exemap) then
  2050. begin
  2051. exemap.Add('');
  2052. exemap.Add('Entry symbol '+EntryName);
  2053. end;
  2054. end
  2055. else
  2056. Comment(V_Error,'Entrypoint '+EntryName+' not defined');
  2057. end;
  2058. { Generate VTable tree }
  2059. if cs_link_opt_vtable in current_settings.globalswitches then
  2060. BuildVTableTree(VTInheritList,VTEntryList);
  2061. VTInheritList.Free;
  2062. VTEntryList.Free;
  2063. end;
  2064. procedure TExeOutput.GenerateDebugLink(const dbgname:string;dbgcrc:cardinal);
  2065. var
  2066. debuglink : array[0..1023] of byte;
  2067. len : longint;
  2068. objsec : TObjSection;
  2069. exesec : TExeSection;
  2070. begin
  2071. { From the gdb manual chapter 15. GDB Files:
  2072. * A filename, with any leading directory components removed, followed by a zero byte,
  2073. * zero to three bytes of padding, as needed to reach the next four-byte boundary within the section, and
  2074. * a four-byte CRC checksum, stored in the same endianness used for the executable file itself. The checksum is computed
  2075. on the debugging information file's full contents by the function given below, passing zero as the crc argument.
  2076. }
  2077. fillchar(debuglink,sizeof(debuglink),0);
  2078. len:=0;
  2079. move(dbgname[1],debuglink[len],length(dbgname));
  2080. inc(len,length(dbgname)+1);
  2081. len:=align(len,4);
  2082. if source_info.endian<>target_info.endian then
  2083. SwapEndian(dbgcrc);
  2084. move(dbgcrc,debuglink[len],sizeof(cardinal));
  2085. inc(len,4);
  2086. { Add section }
  2087. exesec:=FindExeSection(debuglinkname);
  2088. if not assigned(exesec) then
  2089. exesec:=CExeSection.create(ExeSectionList,debuglinkname);
  2090. exesec.SecOptions:=[oso_data,oso_keep];
  2091. exesec.SecAlign:=4;
  2092. objsec:=internalObjData.createsection(exesec.name,1,exesec.SecOptions);
  2093. internalObjData.writebytes(debuglink,len);
  2094. exesec.AddObjSection(objsec);
  2095. end;
  2096. procedure TExeOutput.GenerateLibraryImports(ImportLibraryList:TFPHashObjectList);
  2097. begin
  2098. end;
  2099. function ByAddress(item1,item2:pointer):longint;
  2100. var
  2101. sym1:TObjSymbol absolute item1;
  2102. sym2:TObjSymbol absolute item2;
  2103. begin
  2104. result:=sym1.address-sym2.address;
  2105. end;
  2106. procedure TExeOutput.PrintMemoryMap;
  2107. var
  2108. exesec : TExeSection;
  2109. objsec : TObjSection;
  2110. objsym : TObjSymbol;
  2111. i,j,k,m: longint;
  2112. list : TFPList;
  2113. flag : boolean;
  2114. begin
  2115. if not assigned(exemap) then
  2116. exit;
  2117. { create a list of symbols sorted by address }
  2118. list:=TFPList.Create;
  2119. for i:=0 to ExeSymbolList.Count-1 do
  2120. list.Add(TExeSymbol(ExeSymbolList[i]).ObjSymbol);
  2121. list.Sort(@ByAddress);
  2122. exemap.AddMemoryMapHeader(ImageBase);
  2123. k:=0;
  2124. for i:=0 to ExeSectionList.Count-1 do
  2125. begin
  2126. exesec:=TExeSection(ExeSectionList[i]);
  2127. exemap.AddMemoryMapExeSection(exesec);
  2128. for j:=0 to exesec.ObjSectionList.count-1 do
  2129. begin
  2130. objsec:=TObjSection(exesec.ObjSectionList[j]);
  2131. exemap.AddMemoryMapObjectSection(objsec);
  2132. while (k<list.Count) and (TObjSymbol(list[k]).Address<objsec.MemPos) do
  2133. inc(k);
  2134. while (k<list.Count) do
  2135. begin
  2136. objsym:=TObjSymbol(list[k]);
  2137. if objsym.address>objsec.MemPos+objsec.Size then
  2138. break;
  2139. if objsym.objsection=objsec then
  2140. exemap.AddMemoryMapSymbol(objsym)
  2141. else
  2142. begin
  2143. { Got a symbol with address falling into current section, but
  2144. belonging to a different section. This may happen for zero-length
  2145. sections because symbol list is sorted by address but not by section.
  2146. Do some look-ahead in this case. }
  2147. m:=k+1;
  2148. flag:=false;
  2149. while (m<list.Count) and (TObjSymbol(list[m]).Address=objsym.address) do
  2150. begin
  2151. if TObjSymbol(list[m]).objsection=objsec then
  2152. begin
  2153. flag:=true;
  2154. list.Exchange(k,m);
  2155. exemap.AddMemoryMapSymbol(TObjSymbol(list[k]));
  2156. break;
  2157. end;
  2158. inc(m);
  2159. end;
  2160. if not flag then
  2161. break;
  2162. end;
  2163. inc(k);
  2164. end;
  2165. end;
  2166. end;
  2167. list.Free;
  2168. end;
  2169. procedure TExeOutput.FixupSymbols;
  2170. procedure UpdateSymbol(objsym:TObjSymbol);
  2171. begin
  2172. objsym.bind:=objsym.ExeSymbol.ObjSymbol.bind;
  2173. objsym.offset:=objsym.ExeSymbol.ObjSymbol.offset;
  2174. objsym.size:=objsym.ExeSymbol.ObjSymbol.size;
  2175. objsym.typ:=objsym.ExeSymbol.ObjSymbol.typ;
  2176. objsym.ObjSection:=objsym.ExeSymbol.ObjSymbol.ObjSection;
  2177. end;
  2178. var
  2179. i : longint;
  2180. objsym : TObjSymbol;
  2181. exesym : TExeSymbol;
  2182. begin
  2183. { Print list of Unresolved External symbols }
  2184. for i:=0 to UnresolvedExeSymbols.count-1 do
  2185. begin
  2186. exesym:=TExeSymbol(UnresolvedExeSymbols[i]);
  2187. if exesym.State<>symstate_defined then
  2188. Comment(V_Error,'Undefined symbol: '+exesym.name);
  2189. end;
  2190. {
  2191. Fixing up symbols is done in the following steps:
  2192. 1. Update common references
  2193. 2. Update external references
  2194. }
  2195. { Step 1, Update commons }
  2196. for i:=0 to CommonObjSymbols.count-1 do
  2197. begin
  2198. objsym:=TObjSymbol(CommonObjSymbols[i]);
  2199. if objsym.bind<>AB_COMMON then
  2200. internalerror(200606241);
  2201. UpdateSymbol(objsym);
  2202. end;
  2203. { Step 2, Update externals }
  2204. for i:=0 to ExternalObjSymbols.count-1 do
  2205. begin
  2206. objsym:=TObjSymbol(ExternalObjSymbols[i]);
  2207. if objsym.bind<>AB_EXTERNAL then
  2208. internalerror(200606242);
  2209. UpdateSymbol(objsym);
  2210. end;
  2211. end;
  2212. procedure TExeOutput.MergeStabs;
  2213. var
  2214. stabexesec,
  2215. stabstrexesec : TExeSection;
  2216. relocsec,
  2217. currstabsec,
  2218. currstabstrsec,
  2219. mergedstabsec,
  2220. mergedstabstrsec : TObjSection;
  2221. hstabreloc,
  2222. currstabreloc : TObjRelocation;
  2223. i,j : longint;
  2224. currstabrelocidx,
  2225. mergestabcnt,
  2226. stabcnt : longword;
  2227. skipstab : boolean;
  2228. skipfun : boolean;
  2229. hstab : TObjStabEntry;
  2230. stabrelocofs : longword;
  2231. buf : array[0..1023] of byte;
  2232. bufend,
  2233. bufsize : longint;
  2234. begin
  2235. stabexesec:=FindExeSection('.stab');
  2236. stabstrexesec:=FindExeSection('.stabstr');
  2237. if (stabexesec=nil) or
  2238. (stabstrexesec=nil) or
  2239. (stabexesec.ObjSectionlist.count=0) then
  2240. exit;
  2241. { Create new stabsection }
  2242. stabRelocofs:=pbyte(@hstab.nvalue)-pbyte(@hstab);
  2243. mergedstabsec:=internalObjData.CreateSection(sec_stab,'');
  2244. mergedstabstrsec:=internalObjData.CreateSection(sec_stabstr,'');
  2245. { write stab for hdrsym }
  2246. fillchar(hstab,sizeof(TObjStabEntry),0);
  2247. mergedstabsec.write(hstab,sizeof(TObjStabEntry));
  2248. mergestabcnt:=1;
  2249. { .stabstr starts with a #0 }
  2250. buf[0]:=0;
  2251. mergedstabstrsec.write(buf[0],1);
  2252. skipfun:=false;
  2253. { Copy stabs and corresponding Relocations }
  2254. for i:=0 to stabexesec.ObjSectionList.Count-1 do
  2255. begin
  2256. currstabsec:=TObjSection(stabexesec.ObjSectionList[i]);
  2257. currstabstrsec:=currstabsec.ObjData.findsection('.stabstr');
  2258. if assigned(currstabstrsec) then
  2259. begin
  2260. stabcnt:=currstabsec.Data.size div sizeof(TObjStabEntry);
  2261. currstabsec.Data.seek(0);
  2262. currstabrelocidx:=0;
  2263. for j:=0 to stabcnt-1 do
  2264. begin
  2265. hstabreloc:=nil;
  2266. skipstab:=false;
  2267. currstabsec.Data.read(hstab,sizeof(TObjStabEntry));
  2268. { Only include first hdrsym stab }
  2269. if hstab.ntype=0 then
  2270. skipstab:=true;
  2271. if skipfun then
  2272. begin
  2273. { Skip all stabs for function body until N_RBRAC }
  2274. skipfun:=hstab.ntype<>N_RBRAC;
  2275. skipstab:=true;
  2276. end;
  2277. if not skipstab then
  2278. begin
  2279. { Find corresponding Relocation }
  2280. currstabreloc:=nil;
  2281. while (currstabrelocidx<longword(currstabsec.ObjRelocations.Count)) do
  2282. begin
  2283. currstabreloc:=TObjRelocation(currstabsec.ObjRelocations[currstabrelocidx]);
  2284. if assigned(currstabreloc) and
  2285. (currstabreloc.dataoffset>=longword(j)*sizeof(TObjStabEntry)+stabrelocofs) then
  2286. break;
  2287. inc(currstabrelocidx);
  2288. end;
  2289. if assigned(currstabreloc) and
  2290. (currstabreloc.dataoffset=longword(j)*sizeof(TObjStabEntry)+stabrelocofs) then
  2291. begin
  2292. hstabReloc:=currstabReloc;
  2293. inc(currstabrelocidx);
  2294. end;
  2295. { Check if the stab is refering to a removed section }
  2296. if assigned(hstabreloc) then
  2297. begin
  2298. if assigned(hstabreloc.Symbol) then
  2299. relocsec:=hstabreloc.Symbol.ObjSection
  2300. else
  2301. relocsec:=hstabreloc.ObjSection;
  2302. if not assigned(relocsec) then
  2303. internalerror(200603302);
  2304. if not relocsec.Used then
  2305. begin
  2306. skipstab:=true;
  2307. if (hstab.ntype=N_Function) and (hstab.strpos<>0) then
  2308. begin
  2309. currstabstrsec.Data.seek(hstab.strpos);
  2310. bufsize:=currstabstrsec.Data.read(buf,sizeof(buf));
  2311. bufend:=indexbyte(buf,bufsize,Ord(':'));
  2312. if (bufend<>-1) and (bufend<bufsize-1) and (buf[bufend+1]=Ord('F')) then
  2313. skipfun:=true;
  2314. end;
  2315. end;
  2316. end;
  2317. end;
  2318. if not skipstab then
  2319. begin
  2320. { Copy string in stabstr }
  2321. if hstab.strpos<>0 then
  2322. begin
  2323. currstabstrsec.Data.seek(hstab.strpos);
  2324. hstab.strpos:=mergedstabstrsec.Size;
  2325. repeat
  2326. bufsize:=currstabstrsec.Data.read(buf,sizeof(buf));
  2327. bufend:=indexbyte(buf,bufsize,0);
  2328. if bufend=-1 then
  2329. bufend:=bufsize
  2330. else
  2331. begin
  2332. { include the #0 }
  2333. inc(bufend);
  2334. end;
  2335. mergedstabstrsec.write(buf,bufend);
  2336. until (buf[bufend-1]=0) or (bufsize<sizeof(buf));
  2337. end;
  2338. { Copy and Update the relocation }
  2339. if assigned(hstabreloc) then
  2340. begin
  2341. hstabreloc.Dataoffset:=mergestabcnt*sizeof(TObjStabEntry)+stabRelocofs;
  2342. { Remove from List without freeing the object }
  2343. currstabsec.ObjRelocations.List[currstabrelocidx-1]:=nil;
  2344. mergedstabsec.ObjRelocations.Add(hstabreloc);
  2345. end;
  2346. { Write updated stab }
  2347. mergedstabsec.write(hstab,sizeof(hstab));
  2348. inc(mergestabcnt);
  2349. end;
  2350. end;
  2351. end;
  2352. { Unload stabs }
  2353. if assigned(currstabstrsec) then
  2354. begin
  2355. currstabstrsec.Used:=False;
  2356. currstabstrsec.ReleaseData;
  2357. end;
  2358. currstabsec.Used:=false;
  2359. currstabsec.ReleaseData;
  2360. end;
  2361. { Generate new HdrSym }
  2362. if mergedstabsec.Size>0 then
  2363. begin
  2364. hstab.strpos:=1;
  2365. hstab.ntype:=0;
  2366. hstab.nother:=0;
  2367. hstab.ndesc:=word(mergestabcnt-1);
  2368. hstab.nvalue:=mergedstabstrsec.Size;
  2369. mergedstabsec.Data.seek(0);
  2370. mergedstabsec.Data.write(hstab,sizeof(hstab));
  2371. end;
  2372. { Replace all sections with our combined stabsec }
  2373. stabexesec.ObjSectionList.Clear;
  2374. stabstrexesec.ObjSectionList.Clear;
  2375. stabexesec.AddObjSection(mergedstabsec);
  2376. stabstrexesec.AddObjSection(mergedstabstrsec);
  2377. end;
  2378. procedure TExeOutput.MarkEmptySections;
  2379. var
  2380. i, j : longint;
  2381. exesec : TExeSection;
  2382. doremove : boolean;
  2383. begin
  2384. for i:=0 to ExeSectionList.Count-1 do
  2385. begin
  2386. exesec:=TExeSection(ExeSectionList[i]);
  2387. doremove:=not(oso_keep in exesec.SecOptions) and
  2388. (
  2389. (exesec.ObjSectionlist.count=0) or
  2390. (
  2391. (cs_link_strip in current_settings.globalswitches) and
  2392. not(cs_link_separate_dbg_file in current_settings.globalswitches) and
  2393. (oso_debug in exesec.SecOptions)
  2394. )
  2395. );
  2396. if not doremove then
  2397. begin
  2398. { Check if section has no actual data }
  2399. doremove:=true;
  2400. for j:=0 to exesec.ObjSectionList.Count-1 do
  2401. if TObjSection(exesec.ObjSectionList[j]).Size<>0 then
  2402. begin
  2403. doremove:=false;
  2404. break;
  2405. end;
  2406. end;
  2407. if doremove then
  2408. begin
  2409. Comment(V_Debug,'Disabling empty section '+exesec.name);
  2410. exesec.SecOptions:=exesec.SecOptions+[oso_disabled];
  2411. end;
  2412. end;
  2413. end;
  2414. procedure TExeOutput.RemoveDisabledSections;
  2415. var
  2416. i: longint;
  2417. exesec: TExeSection;
  2418. begin
  2419. for i:=0 to ExeSectionList.Count-1 do
  2420. begin
  2421. exesec:=TExeSection(ExeSectionList[i]);
  2422. if (oso_disabled in exesec.SecOptions) then
  2423. ExeSectionList[i]:=nil;
  2424. end;
  2425. ExeSectionList.Pack;
  2426. end;
  2427. procedure TExeOutput.RemoveDebugInfo;
  2428. var
  2429. i : longint;
  2430. exesec : TExeSection;
  2431. begin
  2432. for i:=0 to ExeSectionList.Count-1 do
  2433. begin
  2434. exesec:=TExeSection(ExeSectionList[i]);
  2435. if (oso_debug in exesec.SecOptions) then
  2436. ExeSectionList[i]:=nil;
  2437. end;
  2438. ExeSectionList.Pack;
  2439. end;
  2440. procedure TExeOutput.RemoveUnreferencedSections;
  2441. var
  2442. ObjSectionWorkList : TFPObjectList;
  2443. procedure AddToObjSectionWorkList(aobjsec:TObjSection);
  2444. begin
  2445. if not aobjsec.Used then
  2446. begin
  2447. aobjsec.Used:=true;
  2448. ObjSectionWorkList.Add(aobjsec);
  2449. end;
  2450. end;
  2451. procedure DoReloc(objreloc:TObjRelocation);
  2452. var
  2453. objsym : TObjSymbol;
  2454. refobjsec : TObjSection;
  2455. begin
  2456. { Disabled Relocation to 0 }
  2457. if objreloc.typ=RELOC_ZERO then
  2458. exit;
  2459. if assigned(objreloc.symbol) then
  2460. begin
  2461. objsym:=objreloc.symbol;
  2462. if objsym.bind<>AB_LOCAL then
  2463. begin
  2464. if not(assigned(objsym.exesymbol) and
  2465. (objsym.exesymbol.State=symstate_defined)) then
  2466. internalerror(200603063);
  2467. objsym:=objsym.exesymbol.objsymbol;
  2468. end;
  2469. if not assigned(objsym.objsection) then
  2470. internalerror(200603062);
  2471. refobjsec:=objsym.objsection;
  2472. end
  2473. else
  2474. if assigned(objreloc.objsection) then
  2475. refobjsec:=objreloc.objsection
  2476. else
  2477. internalerror(200603316);
  2478. if assigned(exemap) then
  2479. begin
  2480. objsym:=objreloc.symbol;
  2481. if assigned(objsym) then
  2482. exemap.Add(' References '+objsym.name+' in '
  2483. +refobjsec.fullname)
  2484. else
  2485. exemap.Add(' References '+refobjsec.fullname);
  2486. end;
  2487. AddToObjSectionWorkList(refobjsec);
  2488. end;
  2489. procedure DoVTableRef(vtable:TExeVTable;VTableIdx:longint);
  2490. var
  2491. i : longint;
  2492. objreloc : TObjRelocation;
  2493. begin
  2494. objreloc:=vtable.VTableRef(VTableIdx);
  2495. if assigned(objreloc) then
  2496. begin
  2497. { Process the relocation now if the ObjSection is
  2498. already processed and marked as used. Otherwise we leave it
  2499. unprocessed. It'll then be resolved when the ObjSection is
  2500. changed to Used }
  2501. if vtable.ExeSymbol.ObjSymbol.ObjSection.Used then
  2502. DoReloc(objreloc);
  2503. end;
  2504. { This recursive walking is done here instead of
  2505. in TExeVTable.VTableRef because we can now process
  2506. all needed relocations }
  2507. for i:=0 to vtable.ChildList.Count-1 do
  2508. DoVTableRef(TExeVTable(vtable.ChildList[i]),VTableIdx);
  2509. end;
  2510. var
  2511. hs : string;
  2512. i,j,k : longint;
  2513. exesec : TExeSection;
  2514. objdata : TObjData;
  2515. objsec : TObjSection;
  2516. objsym : TObjSymbol;
  2517. code : integer;
  2518. vtableidx : longint;
  2519. vtableexesym : TExeSymbol;
  2520. begin
  2521. ObjSectionWorkList:=TFPObjectList.Create(false);
  2522. if assigned(exemap) then
  2523. exemap.AddHeader('Removing unreferenced sections');
  2524. { Initialize by marking all sections unused and
  2525. adding the sections with oso_keep flags to the ObjSectionWorkList }
  2526. for i:=0 to ObjDataList.Count-1 do
  2527. begin
  2528. ObjData:=TObjData(ObjDataList[i]);
  2529. for j:=0 to ObjData.ObjSectionList.Count-1 do
  2530. begin
  2531. objsec:=TObjSection(ObjData.ObjSectionList[j]);
  2532. objsec.Used:=false;
  2533. { TODO: remove debug section always keep}
  2534. if oso_debug in objsec.secoptions then
  2535. objsec.Used:=true;
  2536. if (oso_keep in objsec.secoptions) then
  2537. begin
  2538. AddToObjSectionWorkList(objsec);
  2539. if objsec.name='.fpc.n_links' then
  2540. objsec.Used:=false;
  2541. end;
  2542. end;
  2543. end;
  2544. if assigned(entrysym) then
  2545. AddToObjSectionWorkList(entrysym.exesymbol.objsymbol.objsection);
  2546. { Process all sections, add new sections to process based
  2547. on the symbol references }
  2548. while ObjSectionWorkList.Count>0 do
  2549. begin
  2550. objsec:=TObjSection(ObjSectionWorkList.Last);
  2551. if assigned(exemap) then
  2552. exemap.Add('Keeping '+objsec.FullName+' '+ToStr(objsec.ObjRelocations.Count)+' references');
  2553. ObjSectionWorkList.Delete(ObjSectionWorkList.Count-1);
  2554. { Process Relocations }
  2555. for i:=0 to objsec.ObjRelocations.count-1 do
  2556. DoReloc(TObjRelocation(objsec.ObjRelocations[i]));
  2557. { Process Virtual Entry calls }
  2558. if cs_link_opt_vtable in current_settings.globalswitches then
  2559. begin
  2560. for i:=0 to objsec.VTRefList.count-1 do
  2561. begin
  2562. objsym:=TObjSymbol(objsec.VTRefList[i]);
  2563. hs:=objsym.name;
  2564. Delete(hs,1,Pos('_',hs));
  2565. k:=Pos('$$',hs);
  2566. if k=0 then
  2567. internalerror(200603314);
  2568. vtableexesym:=texesymbol(FExeSymbolList.Find(Copy(hs,1,k-1)));
  2569. val(Copy(hs,k+2,length(hs)-k-1),vtableidx,code);
  2570. if (code<>0) then
  2571. internalerror(200603317);
  2572. if not assigned(vtableexesym) then
  2573. internalerror(200603315);
  2574. if not assigned(vtableexesym.vtable) then
  2575. internalerror(200603316);
  2576. DoVTableRef(vtableexesym.vtable,vtableidx);
  2577. end;
  2578. end;
  2579. end;
  2580. ObjSectionWorkList.Free;
  2581. ObjSectionWorkList:=nil;
  2582. { Remove unused objsections from ExeSectionList }
  2583. for i:=0 to ExeSectionList.Count-1 do
  2584. begin
  2585. exesec:=TExeSection(ExeSectionList[i]);
  2586. for j:=0 to exesec.ObjSectionlist.count-1 do
  2587. begin
  2588. objsec:=TObjSection(exesec.ObjSectionlist[j]);
  2589. if not objsec.used then
  2590. begin
  2591. if assigned(exemap) then
  2592. exemap.Add('Removing '+objsec.FullName);
  2593. exesec.ObjSectionlist[j]:=nil;
  2594. objsec.ReleaseData;
  2595. end;
  2596. end;
  2597. exesec.ObjSectionlist.Pack;
  2598. end;
  2599. end;
  2600. procedure TExeOutput.FixupRelocations;
  2601. var
  2602. i,j : longint;
  2603. exesec : TExeSection;
  2604. objsec : TObjSection;
  2605. begin
  2606. for i:=0 to ExeSectionList.Count-1 do
  2607. begin
  2608. exesec:=TExeSection(ExeSectionList[i]);
  2609. if not assigned(exesec) then
  2610. continue;
  2611. for j:=0 to exesec.ObjSectionlist.count-1 do
  2612. begin
  2613. objsec:=TObjSection(exesec.ObjSectionlist[j]);
  2614. if not objsec.Used then
  2615. internalerror(200603301);
  2616. if (objsec.ObjRelocations.Count>0) and
  2617. not assigned(objsec.data) then
  2618. internalerror(200205183);
  2619. DoRelocationFixup(objsec);
  2620. {for size = 0 data is not valid PM }
  2621. if assigned(objsec.data) and (objsec.data.size<>objsec.size) then
  2622. internalerror(2010092801);
  2623. end;
  2624. end;
  2625. end;
  2626. procedure TExeOutput.RemoveUnusedExeSymbols;
  2627. var
  2628. i : longint;
  2629. sym : TExeSymbol;
  2630. begin
  2631. { Removing unused symbols }
  2632. for i:=0 to ExeSymbolList.Count-1 do
  2633. begin
  2634. sym:=TExeSymbol(ExeSymbolList[i]);
  2635. if not sym.ObjSymbol.objsection.Used then
  2636. ExeSymbolList[i]:=nil;
  2637. end;
  2638. ExeSymbolList.Pack;
  2639. end;
  2640. procedure TExeOutput.SetCurrMemPos(const AValue: qword);
  2641. begin
  2642. if AValue>MaxMemPos then
  2643. Message1(link_f_executable_too_big, target_os_string);
  2644. FCurrMemPos:=AValue;
  2645. end;
  2646. procedure TExeOutput.WriteExeSectionContent;
  2647. var
  2648. exesec : TExeSection;
  2649. objsec : TObjSection;
  2650. i,j : longint;
  2651. begin
  2652. for j:=0 to ExeSectionList.Count-1 do
  2653. begin
  2654. exesec:=TExeSection(ExeSectionList[j]);
  2655. { don't write normal section if writing only debug info }
  2656. if (ExeWriteMode=ewm_dbgonly) and
  2657. not(oso_debug in exesec.SecOptions) then
  2658. continue;
  2659. if oso_data in exesec.SecOptions then
  2660. begin
  2661. FWriter.Writezeros(Align(FWriter.Size,SectionDataAlign)-FWriter.Size);
  2662. for i:=0 to exesec.ObjSectionList.Count-1 do
  2663. begin
  2664. objsec:=TObjSection(exesec.ObjSectionList[i]);
  2665. if oso_data in objsec.secoptions then
  2666. begin
  2667. if not assigned(objsec.data) then
  2668. internalerror(200603042);
  2669. FWriter.writezeros(objsec.dataalignbytes);
  2670. if objsec.DataPos<>FWriter.Size then
  2671. internalerror(200602251);
  2672. FWriter.writearray(objsec.data);
  2673. end;
  2674. end;
  2675. end;
  2676. end;
  2677. end;
  2678. {****************************************************************************
  2679. TObjInput
  2680. ****************************************************************************}
  2681. constructor TObjInput.create;
  2682. begin
  2683. end;
  2684. destructor TObjInput.destroy;
  2685. begin
  2686. inherited destroy;
  2687. end;
  2688. function TObjInput.newObjData(const n:string):TObjData;
  2689. begin
  2690. result:=CObjData.create(n);
  2691. end;
  2692. procedure TObjInput.inputerror(const s : string);
  2693. begin
  2694. Comment(V_Error,s+' while reading '+InputFileName);
  2695. end;
  2696. class function TObjInput.CanReadObjData(AReader:TObjectReader):boolean;
  2697. begin
  2698. result:=false;
  2699. end;
  2700. procedure TObjInput.ReadSectionContent(Data:TObjData);
  2701. var
  2702. i: longint;
  2703. sec: TObjSection;
  2704. begin
  2705. for i:=0 to Data.ObjSectionList.Count-1 do
  2706. begin
  2707. sec:=TObjSection(Data.ObjSectionList[i]);
  2708. { Skip debug sections }
  2709. if (oso_debug in sec.SecOptions) and
  2710. (cs_link_strip in current_settings.globalswitches) and
  2711. not(cs_link_separate_dbg_file in current_settings.globalswitches) then
  2712. continue;
  2713. if assigned(sec.Data) then
  2714. begin
  2715. FReader.Seek(sec.datapos);
  2716. if not FReader.ReadArray(sec.data,sec.Size) then
  2717. begin
  2718. InputError('Can''t read object data');
  2719. exit;
  2720. end;
  2721. end;
  2722. end;
  2723. end;
  2724. {$ifdef MEMDEBUG}
  2725. initialization
  2726. memobjsymbols:=TMemDebug.create('ObjSymbols');
  2727. memobjsymbols.stop;
  2728. memobjsections:=TMemDebug.create('ObjSections');
  2729. memobjsections.stop;
  2730. finalization
  2731. memobjsymbols.free;
  2732. memobjsections.free;
  2733. {$endif MEMDEBUG}
  2734. end.