ogomf.pas 186 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746474747484749475047514752475347544755475647574758475947604761476247634764476547664767476847694770477147724773477447754776477747784779478047814782478347844785478647874788478947904791479247934794479547964797479847994800480148024803480448054806480748084809481048114812481348144815481648174818481948204821482248234824482548264827482848294830483148324833483448354836483748384839484048414842484348444845484648474848484948504851485248534854485548564857485848594860486148624863486448654866486748684869487048714872487348744875487648774878487948804881488248834884488548864887488848894890489148924893489448954896489748984899490049014902490349044905490649074908490949104911491249134914491549164917491849194920492149224923492449254926492749284929493049314932
  1. {
  2. Copyright (c) 2015 by Nikolay Nikolov
  3. Contains the binary Relocatable Object Module Format (OMF) reader and writer
  4. This is the object format used on the i8086-msdos platform.
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit ogomf;
  19. {$i fpcdefs.inc}
  20. {$PackSet 1}
  21. interface
  22. uses
  23. { common }
  24. cclasses,globtype,
  25. { target }
  26. systems,
  27. { assembler }
  28. cpuinfo,cpubase,aasmbase,assemble,link,
  29. { OMF definitions }
  30. omfbase,
  31. { output }
  32. ogbase,
  33. owbase;
  34. type
  35. { TOmfObjSymbol }
  36. TOmfObjSymbol = class(TObjSymbol)
  37. public
  38. { string representation for the linker map file }
  39. function AddressStr(AImageBase: qword): string;override;
  40. end;
  41. { TOmfRelocation }
  42. TOmfRelocation = class(TObjRelocation)
  43. private
  44. FFrameGroup: string;
  45. FOmfFixup: TOmfSubRecord_FIXUP;
  46. public
  47. destructor Destroy; override;
  48. procedure BuildOmfFixup;
  49. property FrameGroup: string read FFrameGroup write FFrameGroup;
  50. property OmfFixup: TOmfSubRecord_FIXUP read FOmfFixup;
  51. end;
  52. TMZExeUnifiedLogicalSegment=class;
  53. { TOmfObjSection }
  54. TOmfObjSection = class(TObjSection)
  55. private
  56. FClassName: string;
  57. FOverlayName: string;
  58. FCombination: TOmfSegmentCombination;
  59. FUse: TOmfSegmentUse;
  60. FPrimaryGroup: TObjSectionGroup;
  61. FSortOrder: Integer;
  62. FMZExeUnifiedLogicalSegment: TMZExeUnifiedLogicalSegment;
  63. FLinNumEntries: TOmfSubRecord_LINNUM_MsLink_LineNumberList;
  64. function GetOmfAlignment: TOmfSegmentAlignment;
  65. public
  66. constructor create(AList:TFPHashObjectList;const Aname:string;Aalign:longint;Aoptions:TObjSectionOptions);override;
  67. destructor destroy;override;
  68. function MemPosStr(AImageBase: qword): string;override;
  69. property ClassName: string read FClassName;
  70. property OverlayName: string read FOverlayName;
  71. property OmfAlignment: TOmfSegmentAlignment read GetOmfAlignment;
  72. property Combination: TOmfSegmentCombination read FCombination;
  73. property Use: TOmfSegmentUse read FUse;
  74. property PrimaryGroup: TObjSectionGroup read FPrimaryGroup;
  75. property SortOrder: Integer read FSortOrder write FSortOrder;
  76. property MZExeUnifiedLogicalSegment: TMZExeUnifiedLogicalSegment read FMZExeUnifiedLogicalSegment write FMZExeUnifiedLogicalSegment;
  77. property LinNumEntries: TOmfSubRecord_LINNUM_MsLink_LineNumberList read FLinNumEntries;
  78. end;
  79. { TOmfObjExportedSymbol }
  80. TOmfObjExportedSymbol = class(TFPHashObject)
  81. private
  82. FExportByOrdinal: Boolean;
  83. FResidentName: Boolean;
  84. FNoData: Boolean;
  85. FParmCount: Integer;
  86. FExportedName: string;
  87. FInternalName: string;
  88. FExportOrdinal: Word;
  89. public
  90. property ExportByOrdinal: Boolean read FExportByOrdinal write FExportByOrdinal;
  91. property ResidentName: Boolean read FResidentName write FResidentName;
  92. property NoData: Boolean read FNoData write FNoData;
  93. property ParmCount: Integer read FParmCount write FParmCount;
  94. property ExportedName: string read FExportedName write FExportedName;
  95. property InternalName: string read FInternalName write FInternalName;
  96. property ExportOrdinal: Word read FExportOrdinal write FExportOrdinal;
  97. end;
  98. { TOmfObjData }
  99. TOmfObjData = class(TObjData)
  100. private
  101. FMainSource: TPathStr;
  102. FImportLibraryList:TFPHashObjectList;
  103. FExportedSymbolList:TFPHashObjectList;
  104. class function CodeSectionName(const aname:string): string;
  105. public
  106. constructor create(const n:string);override;
  107. destructor destroy;override;
  108. function sectiontype2align(atype:TAsmSectiontype):longint;override;
  109. class function sectiontype2class(atype:TAsmSectiontype):string;
  110. function sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;override;
  111. function createsection(atype:TAsmSectionType;const aname:string='';aorder:TAsmSectionOrder=secorder_default):TObjSection;override;
  112. function reffardatasection:TObjSection;
  113. procedure writeReloc(Data:TRelocDataInt;len:aword;p:TObjSymbol;Reloctype:TObjRelocationType);override;
  114. procedure AddImportSymbol(const libname,symname,symmangledname:TCmdStr;OrdNr: longint;isvar:boolean);
  115. procedure AddExportSymbol(aExportByOrdinal,aResidentName,aNoData:Boolean;aParmCount:Integer;aExportedName,aInternalName:string;aExportOrdinal:Word);
  116. property MainSource: TPathStr read FMainSource;
  117. property ImportLibraryList:TFPHashObjectList read FImportLibraryList;
  118. property ExportedSymbolList:TFPHashObjectList read FExportedSymbolList;
  119. end;
  120. { TOmfObjOutput }
  121. TOmfObjOutput = class(tObjOutput)
  122. private
  123. FLNames: TOmfOrderedNameCollection;
  124. FSegments: TFPHashObjectList;
  125. FGroups: TFPHashObjectList;
  126. procedure AddSegment(const name,segclass,ovlname: string;
  127. Alignment: TOmfSegmentAlignment; Combination: TOmfSegmentCombination;
  128. Use: TOmfSegmentUse; Size: TObjSectionOfs);
  129. procedure AddGroup(group: TObjSectionGroup);
  130. procedure WriteSections(Data:TObjData);
  131. procedure WriteSectionContentAndFixups(sec: TObjSection);
  132. procedure WriteLinNumRecords(sec: TOmfObjSection);
  133. procedure section_count_sections(p:TObject;arg:pointer);
  134. procedure group_count_groups(p:TObject;arg:pointer);
  135. procedure WritePUBDEFs(Data: TObjData);
  136. procedure WriteEXTDEFs(Data: TObjData);
  137. property LNames: TOmfOrderedNameCollection read FLNames;
  138. property Segments: TFPHashObjectList read FSegments;
  139. property Groups: TFPHashObjectList read FGroups;
  140. protected
  141. function writeData(Data:TObjData):boolean;override;
  142. public
  143. constructor create(AWriter:TObjectWriter);override;
  144. destructor Destroy;override;
  145. procedure WriteDllImport(const dllname,afuncname,mangledname:string;ordnr:longint;isvar:boolean);
  146. end;
  147. { TOmfObjInput }
  148. TOmfObjInput = class(TObjInput)
  149. private
  150. FLNames: TOmfOrderedNameCollection;
  151. FExtDefs: TFPHashObjectList;
  152. FPubDefs: TFPHashObjectList;
  153. FFixupThreads: TOmfThreads;
  154. FRawRecord: TOmfRawRecord;
  155. FCOMENTRecord: TOmfRecord_COMENT;
  156. FCaseSensitiveSegments: Boolean;
  157. FCaseSensitiveSymbols: Boolean;
  158. function PeekNextRecordType: Byte;
  159. function ReadLNames(RawRec: TOmfRawRecord): Boolean;
  160. function ReadSegDef(RawRec: TOmfRawRecord; objdata:TObjData): Boolean;
  161. function ReadGrpDef(RawRec: TOmfRawRecord; objdata:TObjData): Boolean;
  162. function ReadExtDef(RawRec: TOmfRawRecord; objdata:TObjData): Boolean;
  163. function ReadPubDef(RawRec: TOmfRawRecord; objdata:TObjData): Boolean;
  164. function ReadModEnd(RawRec: TOmfRawRecord; objdata:TObjData): Boolean;
  165. function ReadLeOrLiDataAndFixups(RawRec: TOmfRawRecord; objdata:TObjData): Boolean;
  166. function ReadImpDef(Rec: TOmfRecord_COMENT; objdata:TObjData): Boolean;
  167. function ReadExpDef(Rec: TOmfRecord_COMENT; objdata:TObjData): Boolean;
  168. function ImportOmfFixup(objdata: TObjData; objsec: TOmfObjSection; Fixup: TOmfSubRecord_FIXUP): Boolean;
  169. property LNames: TOmfOrderedNameCollection read FLNames;
  170. property ExtDefs: TFPHashObjectList read FExtDefs;
  171. property PubDefs: TFPHashObjectList read FPubDefs;
  172. { Specifies whether we're case sensitive in regards to segment, class, overlay and group names. }
  173. property CaseSensitiveSegments: Boolean read FCaseSensitiveSegments write FCaseSensitiveSegments;
  174. { Specifies whether symbol names (in EXTDEF and PUBDEF records) are case sensitive. }
  175. property CaseSensitiveSymbols: Boolean read FCaseSensitiveSymbols write FCaseSensitiveSymbols;
  176. public
  177. constructor create;override;
  178. destructor destroy;override;
  179. class function CanReadObjData(AReader:TObjectreader):boolean;override;
  180. function ReadObjData(AReader:TObjectreader;out objdata:TObjData):boolean;override;
  181. end;
  182. { TMZExeRelocation }
  183. TMZExeRelocation = record
  184. offset: Word;
  185. segment: Word;
  186. end;
  187. TMZExeRelocations = array of TMZExeRelocation;
  188. TMZExeExtraHeaderData = array of Byte;
  189. { TMZExeHeader }
  190. TMZExeHeader = class
  191. private
  192. FChecksum: Word;
  193. FExtraHeaderData: TMZExeExtraHeaderData;
  194. FHeaderSizeAlignment: Integer;
  195. FInitialCS: Word;
  196. FInitialIP: Word;
  197. FInitialSP: Word;
  198. FInitialSS: Word;
  199. FLoadableImageSize: DWord;
  200. FMaxExtraParagraphs: Word;
  201. FMinExtraParagraphs: Word;
  202. FOverlayNumber: Word;
  203. FRelocations: TMZExeRelocations;
  204. procedure SetHeaderSizeAlignment(AValue: Integer);
  205. public
  206. constructor Create;
  207. procedure WriteTo(aWriter: TObjectWriter);
  208. procedure AddRelocation(aSegment,aOffset: Word);
  209. property HeaderSizeAlignment: Integer read FHeaderSizeAlignment write SetHeaderSizeAlignment; {default=16, must be multiple of 16}
  210. property Relocations: TMZExeRelocations read FRelocations write FRelocations;
  211. property ExtraHeaderData: TMZExeExtraHeaderData read FExtraHeaderData write FExtraHeaderData;
  212. property LoadableImageSize: DWord read FLoadableImageSize write FLoadableImageSize;
  213. property MinExtraParagraphs: Word read FMinExtraParagraphs write FMinExtraParagraphs;
  214. property MaxExtraParagraphs: Word read FMaxExtraParagraphs write FMaxExtraParagraphs;
  215. property InitialSS: Word read FInitialSS write FInitialSS;
  216. property InitialSP: Word read FInitialSP write FInitialSP;
  217. property Checksum: Word read FChecksum write FChecksum;
  218. property InitialIP: Word read FInitialIP write FInitialIP;
  219. property InitialCS: Word read FInitialCS write FInitialCS;
  220. property OverlayNumber: Word read FOverlayNumber write FOverlayNumber;
  221. end;
  222. { TMZExeSection }
  223. TMZExeSection=class(TExeSection)
  224. public
  225. procedure AddObjSection(objsec:TObjSection;ignoreprops:boolean=false);override;
  226. end;
  227. { TMZExeUnifiedLogicalSegment }
  228. TMZExeUnifiedLogicalSegment=class(TFPHashObject)
  229. private
  230. FObjSectionList: TFPObjectList;
  231. FSegName: TSymStr;
  232. FSegClass: TSymStr;
  233. FPrimaryGroup: string;
  234. public
  235. Size,
  236. MemPos,
  237. MemBasePos: qword;
  238. IsStack: Boolean;
  239. constructor create(HashObjectList:TFPHashObjectList;const s:TSymStr);
  240. destructor destroy;override;
  241. procedure AddObjSection(ObjSec: TOmfObjSection);
  242. procedure CalcMemPos;
  243. function MemPosStr:string;
  244. property ObjSectionList: TFPObjectList read FObjSectionList;
  245. property SegName: TSymStr read FSegName;
  246. property SegClass: TSymStr read FSegClass;
  247. property PrimaryGroup: string read FPrimaryGroup write FPrimaryGroup;
  248. end;
  249. { TMZExeUnifiedLogicalGroup }
  250. TMZExeUnifiedLogicalGroup=class(TFPHashObject)
  251. private
  252. FSegmentList: TFPHashObjectList;
  253. public
  254. Size,
  255. MemPos: qword;
  256. constructor create(HashObjectList:TFPHashObjectList;const s:TSymStr);
  257. destructor destroy;override;
  258. procedure CalcMemPos;
  259. function MemPosStr:string;
  260. procedure AddSegment(UniSeg: TMZExeUnifiedLogicalSegment);
  261. property SegmentList: TFPHashObjectList read FSegmentList;
  262. end;
  263. { TMZExeOutput }
  264. TMZExeOutput = class(TExeOutput)
  265. private
  266. FMZFlatContentSection: TMZExeSection;
  267. FExeUnifiedLogicalSegments: TFPHashObjectList;
  268. FExeUnifiedLogicalGroups: TFPHashObjectList;
  269. FDwarfUnifiedLogicalSegments: TFPHashObjectList;
  270. FHeader: TMZExeHeader;
  271. function GetMZFlatContentSection: TMZExeSection;
  272. procedure CalcDwarfUnifiedLogicalSegmentsForSection(const SecName: TSymStr);
  273. procedure CalcExeUnifiedLogicalSegments;
  274. procedure CalcExeGroups;
  275. procedure CalcSegments_MemBasePos;
  276. procedure WriteMap_SegmentsAndGroups;
  277. procedure WriteMap_HeaderData;
  278. function FindStackSegment: TMZExeUnifiedLogicalSegment;
  279. procedure FillLoadableImageSize;
  280. procedure FillMinExtraParagraphs;
  281. procedure FillMaxExtraParagraphs;
  282. procedure FillStartAddress;
  283. procedure FillStackAddress;
  284. procedure FillHeaderData;
  285. function writeExe:boolean;
  286. function writeCom:boolean;
  287. function writeDebugElf:boolean;
  288. property ExeUnifiedLogicalSegments: TFPHashObjectList read FExeUnifiedLogicalSegments;
  289. property ExeUnifiedLogicalGroups: TFPHashObjectList read FExeUnifiedLogicalGroups;
  290. property DwarfUnifiedLogicalSegments: TFPHashObjectList read FExeUnifiedLogicalSegments;
  291. property Header: TMZExeHeader read FHeader;
  292. protected
  293. procedure Load_Symbol(const aname:string);override;
  294. procedure DoRelocationFixup(objsec:TObjSection);override;
  295. procedure Order_ObjSectionList(ObjSectionList : TFPObjectList;const aPattern:string);override;
  296. procedure MemPos_ExeSection(const aname:string);override;
  297. procedure MemPos_EndExeSection;override;
  298. function writeData:boolean;override;
  299. public
  300. constructor create;override;
  301. destructor destroy;override;
  302. property MZFlatContentSection: TMZExeSection read GetMZFlatContentSection;
  303. end;
  304. const
  305. NewExeHeaderSize = $40;
  306. NewExeSegmentHeaderSize = 8;
  307. NewExeRelocationRecordSize = 8;
  308. type
  309. TNewExeHeaderFlag = (
  310. nehfSingleData, { bit 0 }
  311. nehfMultipleData, { bit 1 }
  312. { 'Global initialization' according to BP7's TDUMP.EXE }
  313. nehfRealMode, { bit 2 }
  314. nehfProtectedModeOnly, { bit 3 }
  315. { 'EMSDIRECT' according to OpenWatcom's wdump }
  316. { '8086 instructions' according to Ralf Brown's Interrupt List }
  317. nehfReserved4, { bit 4 }
  318. { 'EMSBANK' according to OpenWatcom's wdump }
  319. { '80286 instructions' according to Ralf Brown's Interrupt List }
  320. nehfReserved5, { bit 5 }
  321. { 'EMSGLOBAL' according to OpenWatcom's wdump }
  322. { '80386 instructions' according to Ralf Brown's Interrupt List }
  323. nehfReserved6, { bit 6 }
  324. nehfNeedsFPU, { bit 7 }
  325. { Not compatible with windowing API }
  326. nehfNotWindowAPICompatible, { bit 8 }
  327. { Compatible with windowing API }
  328. { (NotWindowAPICompatible + WindowAPICompatible) = Uses windowing API }
  329. nehfWindowAPICompatible, { bit 9 }
  330. { Family Application (OS/2) according to Ralf Brown's Interrupt List }
  331. nehfReserved10, { bit 10 }
  332. nehfSelfLoading, { bit 11 }
  333. nehfReserved12, { bit 12 }
  334. nehfLinkErrors, { bit 13 }
  335. nehfReserved14, { bit 14 }
  336. nehfIsDLL); { bit 15 }
  337. TNewExeHeaderFlags = set of TNewExeHeaderFlag;
  338. TNewExeAdditionalHeaderFlag = (
  339. neahfLFNSupport, { bit 0 }
  340. neahfWindows2ProtectedMode, { bit 1 }
  341. neahfWindows2ProportionalFonts, { bit 2 }
  342. neahfHasGangloadArea); { bit 3 }
  343. TNewExeAdditionalHeaderFlags = set of TNewExeAdditionalHeaderFlag;
  344. TNewExeTargetOS = (
  345. netoUnknown = $00,
  346. netoOS2 = $01,
  347. netoWindows = $02,
  348. netoMultitaskingMsDos4 = $03,
  349. netoWindows386 = $04,
  350. netoBorlandOperatingSystemServices = $05,
  351. netoPharLap286DosExtenderOS2 = $81,
  352. netoPharLap286DosExtenderWindows = $82);
  353. TNewExeSegmentFlag = (
  354. nesfData, { bit 0 }
  355. nesfLoaderAllocatedMemory, { bit 1 }
  356. nesfLoaded, { bit 2 }
  357. nesfReserved3, { bit 3 }
  358. nesfMovable, { bit 4 }
  359. nesfShareable, { bit 5 }
  360. nesfPreload, { bit 6 }
  361. nesfExecuteOnlyCodeOrReadOnlyData, { bit 7 }
  362. nesfHasRelocationData, { bit 8 }
  363. nesfReserved9, { bit 9 }
  364. nesfReserved10, { bit 10 }
  365. nesfReserved11, { bit 11 }
  366. nesfDiscardable, { bit 12 }
  367. nesfReserved13, { bit 13 }
  368. nesfReserved14, { bit 14 }
  369. nesfReserved15); { bit 15 }
  370. TNewExeSegmentFlags = set of TNewExeSegmentFlag;
  371. TNewExeMsDosStub = array of byte;
  372. { TNewExeHeader }
  373. TNewExeHeader = class
  374. private
  375. FMsDosStub: TNewExeMsDosStub;
  376. FLinkerVersion: Byte;
  377. FLinkerRevision: Byte;
  378. FEntryTableOffset: Word;
  379. FEntryTableLength: Word;
  380. FReserved: LongWord;
  381. FFlags: TNewExeHeaderFlags;
  382. FAutoDataSegmentNumber: Word;
  383. FInitialLocalHeapSize: Word;
  384. FInitialStackSize: Word;
  385. FInitialIP: Word;
  386. FInitialCS: Word;
  387. FInitialSP: Word;
  388. FInitialSS: Word;
  389. FSegmentTableEntriesCount: Word;
  390. FModuleReferenceTableEntriesCount: Word;
  391. FNonresidentNameTableLength: Word;
  392. FSegmentTableStart: Word;
  393. FResourceTableStart: Word;
  394. FResidentNameTableStart: Word;
  395. FModuleReferenceTableStart: Word;
  396. FImportedNameTableStart: Word;
  397. FNonresidentNameTableStart: LongWord;
  398. FMovableEntryPointsCount: Word;
  399. FLogicalSectorAlignmentShiftCount: Word;
  400. FResourceSegmentsCount: Word;
  401. FTargetOS: TNewExeTargetOS;
  402. FAdditionalFlags: TNewExeAdditionalHeaderFlags;
  403. FGangLoadAreaStart: Word;
  404. FGangLoadAreaLength: Word;
  405. FReserved2: Word;
  406. FExpectedWindowsVersion: Word;
  407. public
  408. constructor Create;
  409. procedure WriteTo(aWriter: TObjectWriter);
  410. property MsDosStub: TNewExeMsDosStub read FMsDosStub write FMsDosStub;
  411. property LinkerVersion: Byte read FLinkerVersion write FLinkerVersion;
  412. property LinkerRevision: Byte read FLinkerRevision write FLinkerRevision;
  413. property EntryTableOffset: Word read FEntryTableOffset write FEntryTableOffset;
  414. property EntryTableLength: Word read FEntryTableLength write FEntryTableLength;
  415. property Reserved: LongWord read FReserved write FReserved;
  416. property Flags: TNewExeHeaderFlags read FFlags write FFlags;
  417. property AutoDataSegmentNumber: Word read FAutoDataSegmentNumber write FAutoDataSegmentNumber;
  418. property InitialLocalHeapSize: Word read FInitialLocalHeapSize write FInitialLocalHeapSize;
  419. property InitialStackSize: Word read FInitialStackSize write FInitialStackSize;
  420. property InitialIP: Word read FInitialIP write FInitialIP;
  421. property InitialCS: Word read FInitialCS write FInitialCS;
  422. property InitialSP: Word read FInitialSP write FInitialSP;
  423. property InitialSS: Word read FInitialSS write FInitialSS;
  424. property SegmentTableEntriesCount: Word read FSegmentTableEntriesCount write FSegmentTableEntriesCount;
  425. property ModuleReferenceTableEntriesCount: Word read FModuleReferenceTableEntriesCount write FModuleReferenceTableEntriesCount;
  426. property NonresidentNameTableLength: Word read FNonresidentNameTableLength write FNonresidentNameTableLength;
  427. property SegmentTableStart: Word read FSegmentTableStart write FSegmentTableStart;
  428. property ResourceTableStart: Word read FResourceTableStart write FResourceTableStart;
  429. property ResidentNameTableStart: Word read FResidentNameTableStart write FResidentNameTableStart;
  430. property ModuleReferenceTableStart: Word read FModuleReferenceTableStart write FModuleReferenceTableStart;
  431. property ImportedNameTableStart: Word read FImportedNameTableStart write FImportedNameTableStart;
  432. property NonresidentNameTableStart: LongWord read FNonresidentNameTableStart write FNonresidentNameTableStart;
  433. property MovableEntryPointsCount: Word read FMovableEntryPointsCount write FMovableEntryPointsCount;
  434. property LogicalSectorAlignmentShiftCount: Word read FLogicalSectorAlignmentShiftCount write FLogicalSectorAlignmentShiftCount;
  435. property ResourceSegmentsCount: Word read FResourceSegmentsCount write FResourceSegmentsCount;
  436. property TargetOS: TNewExeTargetOS read FTargetOS write FTargetOS;
  437. property AdditionalFlags: TNewExeAdditionalHeaderFlags read FAdditionalFlags write FAdditionalFlags;
  438. property GangLoadAreaStart: Word read FGangLoadAreaStart write FGangLoadAreaStart;
  439. property GangLoadAreaLength: Word read FGangLoadAreaLength write FGangLoadAreaLength;
  440. property Reserved2: Word read FReserved2 write FReserved2;
  441. property ExpectedWindowsVersion: Word read FExpectedWindowsVersion write FExpectedWindowsVersion;
  442. end;
  443. { TNewExeResourceTable }
  444. TNewExeResourceTable = class
  445. private
  446. FResourceDataAlignmentShiftCount: Word;
  447. function GetSize: QWord;
  448. public
  449. constructor Create;
  450. procedure WriteTo(aWriter: TObjectWriter);
  451. property ResourceDataAlignmentShiftCount: Word read FResourceDataAlignmentShiftCount write FResourceDataAlignmentShiftCount;
  452. property Size: QWord read GetSize;
  453. end;
  454. { TNewExeExportNameTableEntry }
  455. TNewExeExportNameTableEntry = class(TFPHashObject)
  456. private
  457. FOrdinalNr: Word;
  458. public
  459. constructor Create(HashObjectList:TFPHashObjectList;const s:TSymStr;OrdNr:Word);
  460. property OrdinalNr: Word read FOrdinalNr write FOrdinalNr;
  461. end;
  462. { TNewExeExportNameTable }
  463. TNewExeExportNameTable = class(TFPHashObjectList)
  464. private
  465. function GetSize: QWord;
  466. public
  467. procedure WriteTo(aWriter: TObjectWriter);
  468. property Size: QWord read GetSize;
  469. end;
  470. TNewExeImportedNameTable = class;
  471. { TNewExeModuleReferenceTableEntry }
  472. TNewExeModuleReferenceTableEntry = class(TFPHashObject)
  473. end;
  474. { TNewExeModuleReferenceTable }
  475. TNewExeModuleReferenceTable = class(TFPHashObjectList)
  476. private
  477. function GetSize: QWord;
  478. public
  479. procedure AddModuleReference(const dllname:TSymStr);
  480. procedure WriteTo(aWriter: TObjectWriter;imptbl:TNewExeImportedNameTable);
  481. property Size: QWord read GetSize;
  482. end;
  483. { TNewExeImportedNameTableEntry }
  484. TNewExeImportedNameTableEntry = class(TFPHashObject)
  485. private
  486. FTableOffset: Word;
  487. public
  488. property TableOffset: Word read FTableOffset write FTableOffset;
  489. end;
  490. { TNewExeImportedNameTable }
  491. TNewExeImportedNameTable = class(TFPHashObjectList)
  492. private
  493. function GetSize: QWord;
  494. public
  495. procedure AddImportedName(const name:TSymStr);
  496. procedure CalcTableOffsets;
  497. procedure WriteTo(aWriter: TObjectWriter);
  498. property Size: QWord read GetSize;
  499. end;
  500. TNewExeEntryPointFlag = (
  501. neepfMovableSegment,
  502. neepfExported,
  503. neepfSingleData
  504. );
  505. TNewExeEntryPointFlags = set of TNewExeEntryPointFlag;
  506. { TNewExeEntryPoint }
  507. TNewExeEntryPoint = class
  508. private
  509. FFlags: TNewExeEntryPointFlags;
  510. FSegment: Byte;
  511. FOffset: Word;
  512. FParmCount: Integer;
  513. function GetFlagsByte: Byte;
  514. public
  515. property Flags: TNewExeEntryPointFlags read FFlags write FFlags;
  516. property Segment: Byte read FSegment write FSegment;
  517. property Offset: Word read FOffset write FOffset;
  518. property ParmCount: Integer read FParmCount write FParmCount;
  519. property FlagsByte: Byte read GetFlagsByte;
  520. end;
  521. { TNewExeEntryTable }
  522. TNewExeEntryTable = class
  523. strict private
  524. FItems: array of TNewExeEntryPoint;
  525. function GetCount: Word;
  526. function GetItems(i: Integer): TNewExeEntryPoint;
  527. function GetSize: QWord;
  528. procedure SetItems(i: Integer; AValue: TNewExeEntryPoint);
  529. function CanBeInSameBundle(i,j:Integer):Boolean;
  530. function BundleSize(StartingElement:Integer): Byte;
  531. public
  532. destructor Destroy;override;
  533. procedure WriteTo(aWriter: TObjectWriter);
  534. procedure GrowTo(aNewCount: Word);
  535. property Size: QWord read GetSize;
  536. property Count: Word read GetCount;
  537. property Items[i: Integer]: TNewExeEntryPoint read GetItems write SetItems;default;
  538. end;
  539. { These are fake "meta sections" used by the linker script. The actual
  540. NewExe sections are segments, limited to 64kb, which means there can be
  541. multiple code segments, etc. These are created manually as object
  542. sections are added. If they fit the current segment, without exceeding
  543. 64kb, they are added to the current segment, otherwise a new segment is
  544. created. The current "meta sections" tells what kind of new segment to
  545. create (e.g. nemsCode means that a new code segment will be created). }
  546. TNewExeMetaSection = (
  547. nemsNone,
  548. nemsCode,
  549. nemsData);
  550. const
  551. NewExeMetaSection2String: array [TNewExeMetaSection] of string[9] = (
  552. '',
  553. 'Code',
  554. 'Data');
  555. type
  556. TNewExeRelocationAddressType = (
  557. neratLoByte = 0, { low 8 bits of 16-bit offset }
  558. neratSelector = 2, { 16-bit selector }
  559. neratFarPointer = 3, { 16-bit selector:16-bit offset }
  560. neratOffset = 5, { 16-bit offset }
  561. neratFarPointer48 = 11, { 16-bit selector:32-bit offset }
  562. neratOffset32 = 13); { 32-bit offset }
  563. TNewExeRelocationType = (
  564. nertInternalRef,
  565. nertImportName,
  566. nertImportOrdinal,
  567. nertOsFixup);
  568. TNewExeOsFixupType = (
  569. neoftFIARQQ_FJARQQ = 1,
  570. neoftFISRQQ_FJSRQQ = 2,
  571. neoftFICRQQ_FJCRQQ = 3,
  572. neoftFIERQQ = 4,
  573. neoftFIDRQQ = 5,
  574. neoftFIWRQQ = 6);
  575. TNewExeInternalRefSegmentType = (
  576. neirstFixed,
  577. neirstMovable);
  578. { TNewExeRelocation }
  579. TNewExeRelocation=class
  580. private
  581. FAddressType: TNewExeRelocationAddressType;
  582. FRelocationType: TNewExeRelocationType;
  583. FIsAdditive: Boolean;
  584. FInternalRefSegmentType: TNewExeInternalRefSegmentType;
  585. FOsFixupType: TNewExeOsFixupType;
  586. FOffset: Word;
  587. FImportModuleIndex: Word;
  588. FImportNameIndex: Word;
  589. FImportOrdinal: Word;
  590. FInternalRefFixedSegmentNumber: Byte;
  591. FInternalRefFixedSegmentOffset: Word;
  592. FInternalRefMovableSegmentEntryTableIndex: Word;
  593. public
  594. procedure EncodeTo(dest: PByte);
  595. property AddressType: TNewExeRelocationAddressType read FAddressType write FAddressType;
  596. property RelocationType: TNewExeRelocationType read FRelocationType write FRelocationType;
  597. property IsAdditive: Boolean read FIsAdditive write FIsAdditive;
  598. property InternalRefSegmentType: TNewExeInternalRefSegmentType read FInternalRefSegmentType write FInternalRefSegmentType;
  599. property OsFixupType: TNewExeOsFixupType read FOsFixupType write FOsFixupType;
  600. property Offset: Word read FOffset write FOffset;
  601. property ImportModuleIndex: Word read FImportModuleIndex write FImportModuleIndex;
  602. property ImportNameIndex: Word read FImportNameIndex write FImportNameIndex;
  603. property ImportOrdinal: Word read FImportOrdinal write FImportOrdinal;
  604. property InternalRefFixedSegmentNumber: Byte read FInternalRefFixedSegmentNumber write FInternalRefFixedSegmentNumber;
  605. property InternalRefFixedSegmentOffset: Word read FInternalRefFixedSegmentOffset write FInternalRefFixedSegmentOffset;
  606. property InternalRefMovableSegmentEntryTableIndex: Word read FInternalRefMovableSegmentEntryTableIndex write FInternalRefMovableSegmentEntryTableIndex;
  607. end;
  608. { TNewExeRelocationList }
  609. TNewExeRelocationList=class
  610. private
  611. FInternalList: TFPObjectList;
  612. function GetCount: Integer;
  613. function GetItem(Index: Integer): TNewExeRelocation;
  614. function GetSize: QWord;
  615. procedure SetCount(AValue: Integer);
  616. procedure SetItem(Index: Integer; AValue: TNewExeRelocation);
  617. public
  618. constructor Create;
  619. destructor Destroy; override;
  620. procedure WriteTo(aWriter: TObjectWriter);
  621. function Add(AObject: TNewExeRelocation): Integer;
  622. property Size: QWord read GetSize;
  623. property Count: Integer read GetCount write SetCount;
  624. property Items[Index: Integer]: TNewExeRelocation read GetItem write SetItem; default;
  625. end;
  626. { TNewExeSection }
  627. TNewExeSection=class(TExeSection)
  628. private
  629. FEarlySize: QWord;
  630. FStackSize: QWord;
  631. FExeMetaSec: TNewExeMetaSection;
  632. FMemBasePos: Word;
  633. FDataPosSectors: Word;
  634. FNewExeSegmentFlags: TNewExeSegmentFlags;
  635. FSizeInFile: QWord;
  636. FRelocations: TNewExeRelocationList;
  637. function GetMinAllocSize: QWord;
  638. function GetNewExeSegmentFlags: TNewExeSegmentFlags;
  639. public
  640. constructor create(AList:TFPHashObjectList;const AName:string);override;
  641. destructor destroy;override;
  642. procedure WriteHeaderTo(aWriter: TObjectWriter);
  643. function MemPosStr(AImageBase: qword): string;override;
  644. procedure AddObjSection(objsec:TObjSection;ignoreprops:boolean=false);override;
  645. function CanAddObjSection(objsec:TObjSection;ExeSectionLimit:QWord):boolean;
  646. property EarlySize: QWord read FEarlySize write FEarlySize;
  647. property StackSize: QWord read FStackSize write FStackSize;
  648. property ExeMetaSec: TNewExeMetaSection read FExeMetaSec write FExeMetaSec;
  649. property MemBasePos: Word read FMemBasePos write FMemBasePos;
  650. property DataPosSectors: Word read FDataPosSectors write FDataPosSectors;
  651. property MinAllocSize: QWord read GetMinAllocSize;
  652. property SizeInFile: QWord read FSizeInFile write FSizeInFile;
  653. property NewExeSegmentFlags: TNewExeSegmentFlags read GetNewExeSegmentFlags write FNewExeSegmentFlags;
  654. property Relocations: TNewExeRelocationList read FRelocations;
  655. end;
  656. { TNewExeOutput }
  657. TNewExeOutput = class(TExeOutput)
  658. private
  659. FHeader: TNewExeHeader;
  660. FImports: TFPHashObjectList;
  661. FCurrExeMetaSec: TNewExeMetaSection;
  662. FResourceTable: TNewExeResourceTable;
  663. FResidentNameTable: TNewExeExportNameTable;
  664. FNonresidentNameTable: TNewExeExportNameTable;
  665. FModuleReferenceTable: TNewExeModuleReferenceTable;
  666. FImportedNameTable: TNewExeImportedNameTable;
  667. FEntryTable: TNewExeEntryTable;
  668. procedure AddImportSymbol(const libname,symname,symmangledname:TCmdStr;OrdNr: longint;isvar:boolean);
  669. procedure AddImportLibrariesExtractedFromObjectModules;
  670. procedure AddNewExeSection;
  671. function WriteNewExe:boolean;
  672. procedure FillImportedNameAndModuleReferenceTable;
  673. function GetHighestExportSymbolOrdinal: Word;
  674. procedure AssignOrdinalsToAllExportSymbols;
  675. procedure AddEntryPointsForAllExportSymbols;
  676. procedure AddExportedNames;
  677. property Header: TNewExeHeader read FHeader;
  678. property CurrExeMetaSec: TNewExeMetaSection read FCurrExeMetaSec write FCurrExeMetaSec;
  679. property ResourceTable: TNewExeResourceTable read FResourceTable;
  680. property ResidentNameTable: TNewExeExportNameTable read FResidentNameTable;
  681. property NonresidentNameTable: TNewExeExportNameTable read FNonresidentNameTable;
  682. property ModuleReferenceTable: TNewExeModuleReferenceTable read FModuleReferenceTable;
  683. property ImportedNameTable: TNewExeImportedNameTable read FImportedNameTable;
  684. property EntryTable: TNewExeEntryTable read FEntryTable;
  685. protected
  686. procedure DoRelocationFixup(objsec:TObjSection);override;
  687. procedure Order_ObjSectionList(ObjSectionList : TFPObjectList;const aPattern:string);override;
  688. public
  689. constructor create;override;
  690. destructor destroy;override;
  691. procedure Order_ExeSection(const aname:string);override;
  692. procedure Order_EndExeSection;override;
  693. procedure Order_ObjSection(const aname:string);override;
  694. procedure MemPos_Start;override;
  695. procedure GenerateLibraryImports(ImportLibraryList:TFPHashObjectList);override;
  696. function writeData:boolean;override;
  697. end;
  698. TOmfAssembler = class(tinternalassembler)
  699. constructor create(info: pasminfo; smart:boolean);override;
  700. end;
  701. function StripDllExt(const DllName:TSymStr):TSymStr;
  702. function MaybeAddDllExt(const DllName:TSymStr):TSymStr;
  703. implementation
  704. uses
  705. SysUtils,
  706. cutils,verbose,globals,
  707. fmodule,aasmtai,aasmdata,
  708. ogmap,owomflib,elfbase,
  709. version
  710. ;
  711. const win16stub : array[0..255] of byte=(
  712. $4d,$5a,$00,$01,$01,$00,$00,$00,$08,$00,$10,$00,$ff,$ff,$08,$00,
  713. $00,$01,$00,$00,$00,$00,$00,$00,$40,$00,$00,$00,$00,$00,$00,$00,
  714. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  715. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$01,$00,$00,
  716. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  717. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  718. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  719. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  720. $ba,$10,$00,$0e,$1f,$b4,$09,$cd,$21,$b8,$01,$4c,$cd,$21,$90,$90,
  721. $54,$68,$69,$73,$20,$70,$72,$6f,$67,$72,$61,$6d,$20,$72,$65,$71,
  722. $75,$69,$72,$65,$73,$20,$4d,$69,$63,$72,$6f,$73,$6f,$66,$74,$20,
  723. $57,$69,$6e,$64,$6f,$77,$73,$2e,$0d,$0a,$24,$20,$20,$20,$20,$20,
  724. $20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,
  725. $20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,
  726. $20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,
  727. $20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20);
  728. {****************************************************************************
  729. TTISTrailer
  730. ****************************************************************************}
  731. const
  732. TIS_TRAILER_SIGNATURE: array[1..4] of char='TIS'#0;
  733. TIS_TRAILER_VENDOR_TIS=0;
  734. TIS_TRAILER_TYPE_TIS_DWARF=0;
  735. type
  736. TTISTrailer=record
  737. tis_signature: array[1..4] of char;
  738. tis_vendor,
  739. tis_type,
  740. tis_size: LongWord;
  741. end;
  742. procedure MayBeSwapTISTrailer(var h: TTISTrailer);
  743. begin
  744. if source_info.endian<>target_info.endian then
  745. with h do
  746. begin
  747. tis_vendor:=swapendian(tis_vendor);
  748. tis_type:=swapendian(tis_type);
  749. tis_size:=swapendian(tis_size);
  750. end;
  751. end;
  752. {****************************************************************************
  753. TOmfObjSymbol
  754. ****************************************************************************}
  755. function TOmfObjSymbol.AddressStr(AImageBase: qword): string;
  756. var
  757. base: qword;
  758. begin
  759. if assigned(objsection.ExeSection) and (objsection.ExeSection is TNewExeSection) then
  760. Result:=HexStr(TNewExeSection(objsection.ExeSection).MemBasePos,4)+':'+HexStr(address,4)
  761. else
  762. begin
  763. if assigned(TOmfObjSection(objsection).MZExeUnifiedLogicalSegment) then
  764. base:=TOmfObjSection(objsection).MZExeUnifiedLogicalSegment.MemBasePos
  765. else
  766. base:=(address shr 4) shl 4;
  767. Result:=HexStr(base shr 4,4)+':'+HexStr(address-base,4);
  768. end;
  769. end;
  770. {****************************************************************************
  771. TOmfRelocation
  772. ****************************************************************************}
  773. destructor TOmfRelocation.Destroy;
  774. begin
  775. FOmfFixup.Free;
  776. inherited Destroy;
  777. end;
  778. procedure TOmfRelocation.BuildOmfFixup;
  779. begin
  780. FreeAndNil(FOmfFixup);
  781. FOmfFixup:=TOmfSubRecord_FIXUP.Create;
  782. if ObjSection<>nil then
  783. begin
  784. FOmfFixup.LocationOffset:=DataOffset;
  785. if typ in [RELOC_ABSOLUTE16,RELOC_RELATIVE16] then
  786. FOmfFixup.LocationType:=fltOffset
  787. else if typ in [RELOC_ABSOLUTE32,RELOC_RELATIVE32] then
  788. FOmfFixup.LocationType:=fltOffset32
  789. else if typ in [RELOC_SEG,RELOC_SEGREL] then
  790. FOmfFixup.LocationType:=fltBase
  791. else
  792. internalerror(2015041501);
  793. FOmfFixup.FrameDeterminedByThread:=False;
  794. FOmfFixup.TargetDeterminedByThread:=False;
  795. if typ in [RELOC_ABSOLUTE16,RELOC_ABSOLUTE32,RELOC_SEG] then
  796. FOmfFixup.Mode:=fmSegmentRelative
  797. else if typ in [RELOC_RELATIVE16,RELOC_RELATIVE32,RELOC_SEGREL] then
  798. FOmfFixup.Mode:=fmSelfRelative
  799. else
  800. internalerror(2015041401);
  801. if typ in [RELOC_ABSOLUTE16,RELOC_ABSOLUTE32,RELOC_RELATIVE16,RELOC_RELATIVE32] then
  802. begin
  803. FOmfFixup.TargetMethod:=ftmSegmentIndexNoDisp;
  804. FOmfFixup.TargetDatum:=ObjSection.Index;
  805. if TOmfObjSection(ObjSection).PrimaryGroup<>nil then
  806. begin
  807. FOmfFixup.FrameMethod:=ffmGroupIndex;
  808. FOmfFixup.FrameDatum:=TOmfObjSection(ObjSection).PrimaryGroup.index;
  809. end
  810. else
  811. FOmfFixup.FrameMethod:=ffmTarget;
  812. end
  813. else
  814. begin
  815. FOmfFixup.FrameMethod:=ffmTarget;
  816. if TOmfObjSection(ObjSection).PrimaryGroup<>nil then
  817. begin
  818. FOmfFixup.TargetMethod:=ftmGroupIndexNoDisp;
  819. FOmfFixup.TargetDatum:=TOmfObjSection(ObjSection).PrimaryGroup.index;
  820. end
  821. else
  822. begin
  823. FOmfFixup.TargetMethod:=ftmSegmentIndexNoDisp;
  824. FOmfFixup.TargetDatum:=ObjSection.Index;
  825. end;
  826. end;
  827. end
  828. else if symbol<>nil then
  829. begin
  830. FOmfFixup.LocationOffset:=DataOffset;
  831. if typ in [RELOC_ABSOLUTE16,RELOC_RELATIVE16] then
  832. FOmfFixup.LocationType:=fltOffset
  833. else if typ in [RELOC_ABSOLUTE32,RELOC_RELATIVE32] then
  834. FOmfFixup.LocationType:=fltOffset32
  835. else if typ in [RELOC_SEG,RELOC_SEGREL] then
  836. FOmfFixup.LocationType:=fltBase
  837. else
  838. internalerror(2015041501);
  839. FOmfFixup.FrameDeterminedByThread:=False;
  840. FOmfFixup.TargetDeterminedByThread:=False;
  841. if typ in [RELOC_ABSOLUTE16,RELOC_ABSOLUTE32,RELOC_SEG] then
  842. FOmfFixup.Mode:=fmSegmentRelative
  843. else if typ in [RELOC_RELATIVE16,RELOC_RELATIVE32,RELOC_SEGREL] then
  844. FOmfFixup.Mode:=fmSelfRelative
  845. else
  846. internalerror(2015041401);
  847. FOmfFixup.TargetMethod:=ftmExternalIndexNoDisp;
  848. FOmfFixup.TargetDatum:=symbol.symidx;
  849. FOmfFixup.FrameMethod:=ffmTarget;
  850. end
  851. else if group<>nil then
  852. begin
  853. FOmfFixup.LocationOffset:=DataOffset;
  854. if typ in [RELOC_ABSOLUTE16,RELOC_RELATIVE16] then
  855. FOmfFixup.LocationType:=fltOffset
  856. else if typ in [RELOC_ABSOLUTE32,RELOC_RELATIVE32] then
  857. FOmfFixup.LocationType:=fltOffset32
  858. else if typ in [RELOC_SEG,RELOC_SEGREL] then
  859. FOmfFixup.LocationType:=fltBase
  860. else
  861. internalerror(2015041501);
  862. FOmfFixup.FrameDeterminedByThread:=False;
  863. FOmfFixup.TargetDeterminedByThread:=False;
  864. if typ in [RELOC_ABSOLUTE16,RELOC_ABSOLUTE32,RELOC_SEG] then
  865. FOmfFixup.Mode:=fmSegmentRelative
  866. else if typ in [RELOC_RELATIVE16,RELOC_RELATIVE32,RELOC_SEGREL] then
  867. FOmfFixup.Mode:=fmSelfRelative
  868. else
  869. internalerror(2015041401);
  870. FOmfFixup.FrameMethod:=ffmTarget;
  871. FOmfFixup.TargetMethod:=ftmGroupIndexNoDisp;
  872. FOmfFixup.TargetDatum:=group.index;
  873. end
  874. else
  875. internalerror(2015040702);
  876. end;
  877. {****************************************************************************
  878. TOmfObjSection
  879. ****************************************************************************}
  880. function TOmfObjSection.GetOmfAlignment: TOmfSegmentAlignment;
  881. begin
  882. case SecAlign of
  883. 1:
  884. result:=saRelocatableByteAligned;
  885. 2:
  886. result:=saRelocatableWordAligned;
  887. 4:
  888. result:=saRelocatableDWordAligned;
  889. 16:
  890. result:=saRelocatableParaAligned;
  891. 256:
  892. result:=saRelocatablePageAligned;
  893. 4096:
  894. result:=saNotSupported;
  895. else
  896. internalerror(2015041504);
  897. end;
  898. end;
  899. constructor TOmfObjSection.create(AList: TFPHashObjectList;
  900. const Aname: string; Aalign: longint; Aoptions: TObjSectionOptions);
  901. begin
  902. inherited create(AList, Aname, Aalign, Aoptions);
  903. FCombination:=scPublic;
  904. FUse:=suUse16;
  905. FLinNumEntries:=TOmfSubRecord_LINNUM_MsLink_LineNumberList.Create;
  906. end;
  907. destructor TOmfObjSection.destroy;
  908. begin
  909. FLinNumEntries.Free;
  910. inherited destroy;
  911. end;
  912. function TOmfObjSection.MemPosStr(AImageBase: qword): string;
  913. begin
  914. if Assigned(MZExeUnifiedLogicalSegment) then
  915. Result:=HexStr(MZExeUnifiedLogicalSegment.MemBasePos shr 4,4)+':'+
  916. HexStr(MemPos-MZExeUnifiedLogicalSegment.MemBasePos,4)
  917. else if Assigned(ExeSection) and (ExeSection is TNewExeSection) then
  918. Result:=HexStr(TNewExeSection(ExeSection).MemBasePos,4)+':'+HexStr(mempos,4)
  919. else
  920. Result:=inherited;
  921. end;
  922. {****************************************************************************
  923. TOmfObjData
  924. ****************************************************************************}
  925. class function TOmfObjData.CodeSectionName(const aname: string): string;
  926. begin
  927. {$ifdef i8086}
  928. if current_settings.x86memorymodel in x86_far_code_models then
  929. begin
  930. if cs_huge_code in current_settings.moduleswitches then
  931. result:=aname + '_TEXT'
  932. else
  933. result:=current_module.modulename^ + '_TEXT';
  934. end
  935. else
  936. {$endif}
  937. result:='_TEXT';
  938. end;
  939. constructor TOmfObjData.create(const n: string);
  940. begin
  941. inherited create(n);
  942. CObjSymbol:=TOmfObjSymbol;
  943. CObjSection:=TOmfObjSection;
  944. createsectiongroup('DGROUP');
  945. FMainSource:=current_module.mainsource;
  946. FImportLibraryList:=TFPHashObjectList.Create(true);
  947. FExportedSymbolList:=TFPHashObjectList.Create(true);
  948. end;
  949. destructor TOmfObjData.destroy;
  950. begin
  951. FExportedSymbolList.Free;
  952. FImportLibraryList.Free;
  953. inherited destroy;
  954. end;
  955. function TOmfObjData.sectiontype2align(atype: TAsmSectiontype): longint;
  956. begin
  957. Result:=omf_sectiontype2align(atype);
  958. end;
  959. class function TOmfObjData.sectiontype2class(atype: TAsmSectiontype): string;
  960. begin
  961. Result:=omf_segclass(atype);
  962. end;
  963. function TOmfObjData.sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;
  964. var
  965. sep : string[3];
  966. secname : string;
  967. begin
  968. if (atype=sec_user) then
  969. Result:=aname
  970. else
  971. begin
  972. if omf_secnames[atype]=omf_secnames[sec_code] then
  973. secname:=CodeSectionName(aname)
  974. else if omf_segclass(atype)='FAR_DATA' then
  975. secname:=current_module.modulename^ + '_DATA'
  976. else
  977. secname:=omf_secnames[atype];
  978. if create_smartlink_sections and (aname<>'') then
  979. begin
  980. case aorder of
  981. secorder_begin :
  982. sep:='.b_';
  983. secorder_end :
  984. sep:='.z_';
  985. else
  986. sep:='.n_';
  987. end;
  988. result:=UpCase(secname+sep+aname);
  989. end
  990. else
  991. result:=secname;
  992. end;
  993. end;
  994. function TOmfObjData.createsection(atype: TAsmSectionType; const aname: string; aorder: TAsmSectionOrder): TObjSection;
  995. var
  996. is_new: Boolean;
  997. primary_group: String;
  998. grp: TObjSectionGroup;
  999. begin
  1000. is_new:=TObjSection(ObjSectionList.Find(sectionname(atype,aname,aorder)))=nil;
  1001. Result:=inherited createsection(atype, aname, aorder);
  1002. if is_new then
  1003. begin
  1004. TOmfObjSection(Result).FClassName:=sectiontype2class(atype);
  1005. if atype=sec_stack then
  1006. TOmfObjSection(Result).FCombination:=scStack
  1007. else if atype in [sec_debug_frame,sec_debug_info,sec_debug_line,sec_debug_abbrev,sec_debug_aranges,sec_debug_ranges] then
  1008. begin
  1009. TOmfObjSection(Result).FUse:=suUse32;
  1010. TOmfObjSection(Result).SizeLimit:=high(longword);
  1011. end;
  1012. primary_group:=omf_section_primary_group(atype,aname);
  1013. if primary_group<>'' then
  1014. begin
  1015. { find the primary group, if it already exists, else create it }
  1016. grp:=nil;
  1017. if GroupsList<>nil then
  1018. grp:=TObjSectionGroup(GroupsList.Find(primary_group));
  1019. if grp=nil then
  1020. grp:=createsectiongroup(primary_group);
  1021. { add the current section to the group }
  1022. SetLength(grp.members,Length(grp.members)+1);
  1023. grp.members[High(grp.members)]:=Result;
  1024. TOmfObjSection(Result).FPrimaryGroup:=grp;
  1025. end;
  1026. end;
  1027. end;
  1028. function TOmfObjData.reffardatasection: TObjSection;
  1029. var
  1030. secname: string;
  1031. begin
  1032. secname:=current_module.modulename^ + '_DATA';
  1033. result:=TObjSection(ObjSectionList.Find(secname));
  1034. if not assigned(result) then
  1035. begin
  1036. result:=CObjSection.create(ObjSectionList,secname,2,[oso_Data,oso_load,oso_write]);
  1037. result.ObjData:=self;
  1038. TOmfObjSection(Result).FClassName:='FAR_DATA';
  1039. end;
  1040. end;
  1041. procedure TOmfObjData.writeReloc(Data:TRelocDataInt;len:aword;p:TObjSymbol;Reloctype:TObjRelocationType);
  1042. var
  1043. objreloc: TOmfRelocation;
  1044. symaddr: AWord;
  1045. begin
  1046. { RELOC_FARPTR = RELOC_ABSOLUTE16+RELOC_SEG }
  1047. if Reloctype=RELOC_FARPTR then
  1048. begin
  1049. if len<>4 then
  1050. internalerror(2015041502);
  1051. writeReloc(Data,2,p,RELOC_ABSOLUTE16);
  1052. writeReloc(0,2,p,RELOC_SEG);
  1053. exit;
  1054. end
  1055. { RELOC_FARPTR48 = RELOC_ABSOLUTE16+RELOC_SEG }
  1056. else if Reloctype=RELOC_FARPTR48 then
  1057. begin
  1058. if len<>6 then
  1059. internalerror(2015041502);
  1060. writeReloc(Data,4,p,RELOC_ABSOLUTE32);
  1061. writeReloc(0,2,p,RELOC_SEG);
  1062. exit;
  1063. end;
  1064. if CurrObjSec=nil then
  1065. internalerror(200403072);
  1066. objreloc:=nil;
  1067. if Reloctype in [RELOC_FARDATASEG,RELOC_FARDATASEGREL] then
  1068. begin
  1069. if Reloctype=RELOC_FARDATASEG then
  1070. objreloc:=TOmfRelocation.CreateSection(CurrObjSec.Size,reffardatasection,RELOC_SEG)
  1071. else
  1072. objreloc:=TOmfRelocation.CreateSection(CurrObjSec.Size,reffardatasection,RELOC_SEGREL);
  1073. CurrObjSec.ObjRelocations.Add(objreloc);
  1074. end
  1075. else if assigned(p) then
  1076. begin
  1077. { real address of the symbol }
  1078. symaddr:=p.address;
  1079. if p.bind=AB_EXTERNAL then
  1080. begin
  1081. objreloc:=TOmfRelocation.CreateSymbol(CurrObjSec.Size,p,Reloctype);
  1082. CurrObjSec.ObjRelocations.Add(objreloc);
  1083. end
  1084. { relative relocations within the same section can be calculated directly,
  1085. without the need to emit a relocation entry }
  1086. else if (p.objsection=CurrObjSec) and
  1087. (p.bind<>AB_COMMON) and
  1088. (Reloctype=RELOC_RELATIVE) then
  1089. begin
  1090. data:=data+symaddr-len-CurrObjSec.Size;
  1091. end
  1092. else
  1093. begin
  1094. objreloc:=TOmfRelocation.CreateSection(CurrObjSec.Size,p.objsection,Reloctype);
  1095. CurrObjSec.ObjRelocations.Add(objreloc);
  1096. if not (Reloctype in [RELOC_SEG,RELOC_SEGREL]) then
  1097. inc(data,symaddr);
  1098. end;
  1099. end
  1100. else if Reloctype in [RELOC_DGROUP,RELOC_DGROUPREL] then
  1101. begin
  1102. if Reloctype=RELOC_DGROUP then
  1103. objreloc:=TOmfRelocation.CreateGroup(CurrObjSec.Size,TObjSectionGroup(GroupsList.Find('DGROUP')),RELOC_SEG)
  1104. else
  1105. objreloc:=TOmfRelocation.CreateGroup(CurrObjSec.Size,TObjSectionGroup(GroupsList.Find('DGROUP')),RELOC_SEGREL);
  1106. CurrObjSec.ObjRelocations.Add(objreloc);
  1107. end;
  1108. CurrObjSec.write(data,len);
  1109. end;
  1110. procedure TOmfObjData.AddImportSymbol(const libname, symname,
  1111. symmangledname: TCmdStr; OrdNr: longint; isvar: boolean);
  1112. var
  1113. ImportLibrary : TImportLibrary;
  1114. ImportSymbol : TFPHashObject;
  1115. begin
  1116. ImportLibrary:=TImportLibrary(ImportLibraryList.Find(libname));
  1117. if not assigned(ImportLibrary) then
  1118. ImportLibrary:=TImportLibrary.Create(ImportLibraryList,libname);
  1119. ImportSymbol:=TFPHashObject(ImportLibrary.ImportSymbolList.Find(symname));
  1120. if not assigned(ImportSymbol) then
  1121. ImportSymbol:=TImportSymbol.Create(ImportLibrary.ImportSymbolList,symname,symmangledname,OrdNr,isvar);
  1122. end;
  1123. procedure TOmfObjData.AddExportSymbol(aExportByOrdinal, aResidentName,
  1124. aNoData: Boolean; aParmCount: Integer; aExportedName,
  1125. aInternalName: string; aExportOrdinal: Word);
  1126. var
  1127. s: TOmfObjExportedSymbol;
  1128. begin
  1129. s:=TOmfObjExportedSymbol.Create(ExportedSymbolList,aInternalName);
  1130. with s do
  1131. begin
  1132. ExportByOrdinal:=aExportByOrdinal;
  1133. ResidentName:=aResidentName;
  1134. NoData:=aNoData;
  1135. ParmCount:=aParmCount;
  1136. ExportedName:=aExportedName;
  1137. InternalName:=aInternalName;
  1138. ExportOrdinal:=aExportOrdinal;
  1139. end;
  1140. end;
  1141. {****************************************************************************
  1142. TOmfObjOutput
  1143. ****************************************************************************}
  1144. procedure TOmfObjOutput.AddSegment(const name, segclass, ovlname: string;
  1145. Alignment: TOmfSegmentAlignment; Combination: TOmfSegmentCombination;
  1146. Use: TOmfSegmentUse; Size: TObjSectionOfs);
  1147. var
  1148. s: TOmfRecord_SEGDEF;
  1149. begin
  1150. s:=TOmfRecord_SEGDEF.Create;
  1151. Segments.Add(name,s);
  1152. s.SegmentNameIndex:=LNames.Add(name);
  1153. s.ClassNameIndex:=LNames.Add(segclass);
  1154. s.OverlayNameIndex:=LNames.Add(ovlname);
  1155. s.Alignment:=Alignment;
  1156. s.Combination:=Combination;
  1157. s.Use:=Use;
  1158. s.SegmentLength:=Size;
  1159. end;
  1160. procedure TOmfObjOutput.AddGroup(group: TObjSectionGroup);
  1161. var
  1162. g: TOmfRecord_GRPDEF;
  1163. seglist: TSegmentList;
  1164. I: Integer;
  1165. begin
  1166. seglist:=nil;
  1167. g:=TOmfRecord_GRPDEF.Create;
  1168. Groups.Add(group.Name,g);
  1169. g.GroupNameIndex:=LNames.Add(group.Name);
  1170. SetLength(seglist,Length(group.members));
  1171. for I:=Low(group.members) to High(group.members) do
  1172. seglist[I]:=group.members[I].index;
  1173. g.SegmentList:=seglist;
  1174. end;
  1175. procedure TOmfObjOutput.WriteSections(Data: TObjData);
  1176. var
  1177. i:longint;
  1178. sec:TObjSection;
  1179. begin
  1180. for i:=0 to Data.ObjSectionList.Count-1 do
  1181. begin
  1182. sec:=TObjSection(Data.ObjSectionList[i]);
  1183. WriteSectionContentAndFixups(sec);
  1184. WriteLinNumRecords(TOmfObjSection(sec));
  1185. end;
  1186. end;
  1187. procedure TOmfObjOutput.WriteSectionContentAndFixups(sec: TObjSection);
  1188. const
  1189. MaxChunkSize=$3fa;
  1190. var
  1191. RawRecord: TOmfRawRecord;
  1192. ChunkStart,ChunkLen: DWord;
  1193. ChunkFixupStart,ChunkFixupEnd: Integer;
  1194. SegIndex: Integer;
  1195. NextOfs: Integer;
  1196. Is32BitLEDATA: Boolean;
  1197. I: Integer;
  1198. begin
  1199. if (oso_data in sec.SecOptions) then
  1200. begin
  1201. if sec.Data=nil then
  1202. internalerror(200403073);
  1203. for I:=0 to sec.ObjRelocations.Count-1 do
  1204. TOmfRelocation(sec.ObjRelocations[I]).BuildOmfFixup;
  1205. SegIndex:=Segments.FindIndexOf(sec.Name);
  1206. RawRecord:=TOmfRawRecord.Create;
  1207. sec.data.seek(0);
  1208. ChunkFixupStart:=0;
  1209. ChunkFixupEnd:=-1;
  1210. ChunkStart:=0;
  1211. ChunkLen:=Min(MaxChunkSize, sec.Data.size-ChunkStart);
  1212. while ChunkLen>0 do
  1213. begin
  1214. { find last fixup in the chunk }
  1215. while (ChunkFixupEnd<(sec.ObjRelocations.Count-1)) and
  1216. (TOmfRelocation(sec.ObjRelocations[ChunkFixupEnd+1]).DataOffset<(ChunkStart+ChunkLen)) do
  1217. inc(ChunkFixupEnd);
  1218. { check if last chunk is crossing the chunk boundary, and trim ChunkLen if necessary }
  1219. if (ChunkFixupEnd>=ChunkFixupStart) and
  1220. ((TOmfRelocation(sec.ObjRelocations[ChunkFixupEnd]).DataOffset+
  1221. TOmfRelocation(sec.ObjRelocations[ChunkFixupEnd]).OmfFixup.LocationSize)>(ChunkStart+ChunkLen)) then
  1222. begin
  1223. ChunkLen:=TOmfRelocation(sec.ObjRelocations[ChunkFixupEnd]).DataOffset-ChunkStart;
  1224. Dec(ChunkFixupEnd);
  1225. end;
  1226. { write LEDATA record }
  1227. Is32BitLEDATA:=TOmfObjSection(sec).Use=suUse32;
  1228. if Is32BitLEDATA then
  1229. RawRecord.RecordType:=RT_LEDATA32
  1230. else
  1231. RawRecord.RecordType:=RT_LEDATA;
  1232. NextOfs:=RawRecord.WriteIndexedRef(0,SegIndex);
  1233. if Is32BitLEDATA then
  1234. begin
  1235. RawRecord.RawData[NextOfs]:=Byte(ChunkStart);
  1236. RawRecord.RawData[NextOfs+1]:=Byte(ChunkStart shr 8);
  1237. RawRecord.RawData[NextOfs+2]:=Byte(ChunkStart shr 16);
  1238. RawRecord.RawData[NextOfs+3]:=Byte(ChunkStart shr 24);
  1239. Inc(NextOfs,4);
  1240. end
  1241. else
  1242. begin
  1243. if ChunkStart>$ffff then
  1244. internalerror(2018052201);
  1245. RawRecord.RawData[NextOfs]:=Byte(ChunkStart);
  1246. RawRecord.RawData[NextOfs+1]:=Byte(ChunkStart shr 8);
  1247. Inc(NextOfs,2);
  1248. end;
  1249. sec.data.read(RawRecord.RawData[NextOfs], ChunkLen);
  1250. Inc(NextOfs, ChunkLen);
  1251. RawRecord.RecordLength:=NextOfs+1;
  1252. RawRecord.CalculateChecksumByte;
  1253. RawRecord.WriteTo(FWriter);
  1254. { write FIXUPP record }
  1255. if ChunkFixupEnd>=ChunkFixupStart then
  1256. begin
  1257. RawRecord.RecordType:=RT_FIXUPP;
  1258. NextOfs:=0;
  1259. for I:=ChunkFixupStart to ChunkFixupEnd do
  1260. begin
  1261. TOmfRelocation(sec.ObjRelocations[I]).OmfFixup.DataRecordStartOffset:=ChunkStart;
  1262. NextOfs:=TOmfRelocation(sec.ObjRelocations[I]).OmfFixup.WriteAt(RawRecord,NextOfs);
  1263. end;
  1264. RawRecord.RecordLength:=NextOfs+1;
  1265. RawRecord.CalculateChecksumByte;
  1266. RawRecord.WriteTo(FWriter);
  1267. end;
  1268. { prepare next chunk }
  1269. Inc(ChunkStart, ChunkLen);
  1270. ChunkLen:=Min(MaxChunkSize, sec.Data.size-ChunkStart);
  1271. ChunkFixupStart:=ChunkFixupEnd+1;
  1272. end;
  1273. RawRecord.Free;
  1274. end;
  1275. end;
  1276. procedure TOmfObjOutput.WriteLinNumRecords(sec: TOmfObjSection);
  1277. var
  1278. SegIndex: Integer;
  1279. RawRecord: TOmfRawRecord;
  1280. LinNumRec: TOmfRecord_LINNUM_MsLink;
  1281. begin
  1282. if (oso_data in sec.SecOptions) then
  1283. begin
  1284. if sec.Data=nil then
  1285. internalerror(200403073);
  1286. if sec.LinNumEntries.Count=0 then
  1287. exit;
  1288. SegIndex:=Segments.FindIndexOf(sec.Name);
  1289. RawRecord:=TOmfRawRecord.Create;
  1290. LinNumRec:=TOmfRecord_LINNUM_MsLink.Create;
  1291. LinNumRec.BaseGroup:=0;
  1292. LinNumRec.BaseSegment:=SegIndex;
  1293. LinNumRec.LineNumberList:=sec.LinNumEntries;
  1294. while LinNumRec.NextIndex<sec.LinNumEntries.Count do
  1295. begin
  1296. LinNumRec.EncodeTo(RawRecord);
  1297. RawRecord.WriteTo(FWriter);
  1298. end;
  1299. LinNumRec.Free;
  1300. RawRecord.Free;
  1301. end;
  1302. end;
  1303. procedure TOmfObjOutput.section_count_sections(p: TObject; arg: pointer);
  1304. begin
  1305. TOmfObjSection(p).index:=pinteger(arg)^;
  1306. inc(pinteger(arg)^);
  1307. end;
  1308. procedure TOmfObjOutput.group_count_groups(p: TObject; arg: pointer);
  1309. begin
  1310. TObjSectionGroup(p).index:=pinteger(arg)^;
  1311. inc(pinteger(arg)^);
  1312. end;
  1313. procedure TOmfObjOutput.WritePUBDEFs(Data: TObjData);
  1314. var
  1315. PubNamesForSection: array of TFPHashObjectList;
  1316. i: Integer;
  1317. objsym: TObjSymbol;
  1318. PublicNameElem: TOmfPublicNameElement;
  1319. RawRecord: TOmfRawRecord;
  1320. PubDefRec: TOmfRecord_PUBDEF;
  1321. begin
  1322. PubNamesForSection:=nil;
  1323. RawRecord:=TOmfRawRecord.Create;
  1324. SetLength(PubNamesForSection,Data.ObjSectionList.Count);
  1325. for i:=0 to Data.ObjSectionList.Count-1 do
  1326. PubNamesForSection[i]:=TFPHashObjectList.Create;
  1327. for i:=0 to Data.ObjSymbolList.Count-1 do
  1328. begin
  1329. objsym:=TObjSymbol(Data.ObjSymbolList[i]);
  1330. if objsym.bind=AB_GLOBAL then
  1331. begin
  1332. PublicNameElem:=TOmfPublicNameElement.Create(PubNamesForSection[objsym.objsection.index-1],objsym.Name);
  1333. PublicNameElem.PublicOffset:=objsym.offset;
  1334. PublicNameElem.IsLocal:=False;
  1335. end
  1336. else if objsym.bind=AB_LOCAL then
  1337. begin
  1338. PublicNameElem:=TOmfPublicNameElement.Create(PubNamesForSection[objsym.objsection.index-1],objsym.Name);
  1339. PublicNameElem.PublicOffset:=objsym.offset;
  1340. PublicNameElem.IsLocal:=True;
  1341. end
  1342. end;
  1343. for i:=0 to Data.ObjSectionList.Count-1 do
  1344. if PubNamesForSection[i].Count>0 then
  1345. begin
  1346. PubDefRec:=TOmfRecord_PUBDEF.Create;
  1347. PubDefRec.BaseSegmentIndex:=i+1;
  1348. if TOmfObjSection(Data.ObjSectionList[i]).PrimaryGroup<>nil then
  1349. PubDefRec.BaseGroupIndex:=Groups.FindIndexOf(TOmfObjSection(Data.ObjSectionList[i]).PrimaryGroup.Name)
  1350. else
  1351. PubDefRec.BaseGroupIndex:=0;
  1352. PubDefRec.PublicNames:=PubNamesForSection[i];
  1353. while PubDefRec.NextIndex<PubDefRec.PublicNames.Count do
  1354. begin
  1355. PubDefRec.EncodeTo(RawRecord);
  1356. RawRecord.WriteTo(FWriter);
  1357. end;
  1358. PubDefRec.Free;
  1359. end;
  1360. for i:=0 to Data.ObjSectionList.Count-1 do
  1361. FreeAndNil(PubNamesForSection[i]);
  1362. RawRecord.Free;
  1363. end;
  1364. procedure TOmfObjOutput.WriteEXTDEFs(Data: TObjData);
  1365. var
  1366. ExtNames: TFPHashObjectList;
  1367. RawRecord: TOmfRawRecord;
  1368. i,idx: Integer;
  1369. objsym: TObjSymbol;
  1370. ExternalNameElem: TOmfExternalNameElement;
  1371. ExtDefRec: TOmfRecord_EXTDEF;
  1372. begin
  1373. ExtNames:=TFPHashObjectList.Create;
  1374. RawRecord:=TOmfRawRecord.Create;
  1375. idx:=1;
  1376. for i:=0 to Data.ObjSymbolList.Count-1 do
  1377. begin
  1378. objsym:=TObjSymbol(Data.ObjSymbolList[i]);
  1379. if objsym.bind=AB_EXTERNAL then
  1380. begin
  1381. ExternalNameElem:=TOmfExternalNameElement.Create(ExtNames,objsym.Name);
  1382. objsym.symidx:=idx;
  1383. Inc(idx);
  1384. end;
  1385. end;
  1386. if ExtNames.Count>0 then
  1387. begin
  1388. ExtDefRec:=TOmfRecord_EXTDEF.Create;
  1389. ExtDefRec.ExternalNames:=ExtNames;
  1390. while ExtDefRec.NextIndex<ExtDefRec.ExternalNames.Count do
  1391. begin
  1392. ExtDefRec.EncodeTo(RawRecord);
  1393. RawRecord.WriteTo(FWriter);
  1394. end;
  1395. ExtDefRec.Free;
  1396. end;
  1397. ExtNames.Free;
  1398. RawRecord.Free;
  1399. end;
  1400. function TOmfObjOutput.writeData(Data:TObjData):boolean;
  1401. var
  1402. RawRecord: TOmfRawRecord;
  1403. Header: TOmfRecord_THEADR;
  1404. Translator_COMENT: TOmfRecord_COMENT;
  1405. DebugFormat_COMENT: TOmfRecord_COMENT;
  1406. LinkPassSeparator_COMENT: TOmfRecord_COMENT;
  1407. LNamesRec: TOmfRecord_LNAMES;
  1408. ModEnd: TOmfRecord_MODEND;
  1409. I: Integer;
  1410. SegDef: TOmfRecord_SEGDEF;
  1411. GrpDef: TOmfRecord_GRPDEF;
  1412. nsections,ngroups: Integer;
  1413. objsym: TObjSymbol;
  1414. begin
  1415. { calc amount of sections we have and set their index, starting with 1 }
  1416. nsections:=1;
  1417. data.ObjSectionList.ForEachCall(@section_count_sections,@nsections);
  1418. { calc amount of groups we have and set their index, starting with 1 }
  1419. ngroups:=1;
  1420. data.GroupsList.ForEachCall(@group_count_groups,@ngroups);
  1421. { maximum amount of sections supported in the omf format is $7fff }
  1422. if (nsections-1)>$7fff then
  1423. internalerror(2015040701);
  1424. { maximum amount of groups supported in the omf format is $7fff }
  1425. if (ngroups-1)>$7fff then
  1426. internalerror(2018062101);
  1427. { write header record }
  1428. RawRecord:=TOmfRawRecord.Create;
  1429. Header:=TOmfRecord_THEADR.Create;
  1430. if cs_debuginfo in current_settings.moduleswitches then
  1431. Header.ModuleName:=TOmfObjData(Data).MainSource
  1432. else
  1433. Header.ModuleName:=Data.Name;
  1434. Header.EncodeTo(RawRecord);
  1435. RawRecord.WriteTo(FWriter);
  1436. Header.Free;
  1437. { write translator COMENT header }
  1438. Translator_COMENT:=TOmfRecord_COMENT.Create;
  1439. Translator_COMENT.CommentClass:=CC_Translator;
  1440. Translator_COMENT.CommentString:='FPC '+full_version_string+
  1441. ' ['+date_string+'] for '+target_cpu_string+' - '+target_info.shortname;
  1442. Translator_COMENT.EncodeTo(RawRecord);
  1443. RawRecord.WriteTo(FWriter);
  1444. Translator_COMENT.Free;
  1445. if (target_dbg.id=dbg_codeview) or
  1446. ((ds_dwarf_omf_linnum in current_settings.debugswitches) and
  1447. (target_dbg.id in [dbg_dwarf2,dbg_dwarf3,dbg_dwarf4])) then
  1448. begin
  1449. DebugFormat_COMENT:=TOmfRecord_COMENT.Create;
  1450. DebugFormat_COMENT.CommentClass:=CC_NewOmfExtension;
  1451. DebugFormat_COMENT.CommentString:='';
  1452. DebugFormat_COMENT.EncodeTo(RawRecord);
  1453. RawRecord.WriteTo(FWriter);
  1454. DebugFormat_COMENT.Free;
  1455. end;
  1456. LNames.Clear;
  1457. LNames.Add(''); { insert an empty string, which has index 1 }
  1458. FSegments.Clear;
  1459. FSegments.Add('',nil);
  1460. FGroups.Clear;
  1461. FGroups.Add('',nil);
  1462. for i:=0 to Data.GroupsList.Count-1 do
  1463. AddGroup(TObjSectionGroup(Data.GroupsList[I]));
  1464. for i:=0 to Data.ObjSectionList.Count-1 do
  1465. with TOmfObjSection(Data.ObjSectionList[I]) do
  1466. AddSegment(Name,ClassName,OverlayName,OmfAlignment,Combination,Use,Size);
  1467. { write LNAMES record(s) }
  1468. LNamesRec:=TOmfRecord_LNAMES.Create;
  1469. LNamesRec.Names:=LNames;
  1470. while LNamesRec.NextIndex<=LNames.Count do
  1471. begin
  1472. LNamesRec.EncodeTo(RawRecord);
  1473. RawRecord.WriteTo(FWriter);
  1474. end;
  1475. LNamesRec.Free;
  1476. { write SEGDEF record(s) }
  1477. for I:=1 to Segments.Count-1 do
  1478. begin
  1479. SegDef:=TOmfRecord_SEGDEF(Segments[I]);
  1480. SegDef.EncodeTo(RawRecord);
  1481. RawRecord.WriteTo(FWriter);
  1482. end;
  1483. { write GRPDEF record(s) }
  1484. for I:=1 to Groups.Count-1 do
  1485. begin
  1486. GrpDef:=TOmfRecord_GRPDEF(Groups[I]);
  1487. GrpDef.EncodeTo(RawRecord);
  1488. RawRecord.WriteTo(FWriter);
  1489. end;
  1490. { write PUBDEF record(s) }
  1491. WritePUBDEFs(Data);
  1492. { write EXTDEF record(s) }
  1493. WriteEXTDEFs(Data);
  1494. { write link pass separator }
  1495. LinkPassSeparator_COMENT:=TOmfRecord_COMENT.Create;
  1496. LinkPassSeparator_COMENT.CommentClass:=CC_LinkPassSeparator;
  1497. LinkPassSeparator_COMENT.CommentString:=#1;
  1498. LinkPassSeparator_COMENT.NoList:=True;
  1499. LinkPassSeparator_COMENT.EncodeTo(RawRecord);
  1500. RawRecord.WriteTo(FWriter);
  1501. LinkPassSeparator_COMENT.Free;
  1502. { write section content, interleaved with fixups }
  1503. WriteSections(Data);
  1504. { write MODEND record }
  1505. ModEnd:=TOmfRecord_MODEND.Create;
  1506. ModEnd.EncodeTo(RawRecord);
  1507. RawRecord.WriteTo(FWriter);
  1508. ModEnd.Free;
  1509. RawRecord.Free;
  1510. result:=true;
  1511. end;
  1512. constructor TOmfObjOutput.create(AWriter:TObjectWriter);
  1513. begin
  1514. inherited create(AWriter);
  1515. cobjdata:=TOmfObjData;
  1516. FLNames:=TOmfOrderedNameCollection.Create(False);
  1517. FSegments:=TFPHashObjectList.Create;
  1518. FSegments.Add('',nil);
  1519. FGroups:=TFPHashObjectList.Create;
  1520. FGroups.Add('',nil);
  1521. end;
  1522. destructor TOmfObjOutput.Destroy;
  1523. begin
  1524. FGroups.Free;
  1525. FSegments.Free;
  1526. FLNames.Free;
  1527. inherited Destroy;
  1528. end;
  1529. procedure TOmfObjOutput.WriteDllImport(const dllname,afuncname,mangledname: string; ordnr: longint; isvar: boolean);
  1530. var
  1531. RawRecord: TOmfRawRecord;
  1532. Header: TOmfRecord_THEADR;
  1533. DllImport_COMENT: TOmfRecord_COMENT=nil;
  1534. DllImport_COMENT_IMPDEF: TOmfRecord_COMENT_IMPDEF=nil;
  1535. ModEnd: TOmfRecord_MODEND;
  1536. begin
  1537. { write header record }
  1538. RawRecord:=TOmfRawRecord.Create;
  1539. Header:=TOmfRecord_THEADR.Create;
  1540. Header.ModuleName:=mangledname;
  1541. Header.EncodeTo(RawRecord);
  1542. RawRecord.WriteTo(FWriter);
  1543. Header.Free;
  1544. { write IMPDEF record }
  1545. DllImport_COMENT_IMPDEF:=TOmfRecord_COMENT_IMPDEF.Create;
  1546. DllImport_COMENT_IMPDEF.InternalName:=mangledname;
  1547. DllImport_COMENT_IMPDEF.ModuleName:=dllname;
  1548. if ordnr <= 0 then
  1549. begin
  1550. DllImport_COMENT_IMPDEF.ImportByOrdinal:=False;
  1551. DllImport_COMENT_IMPDEF.Name:=afuncname;
  1552. end
  1553. else
  1554. begin
  1555. DllImport_COMENT_IMPDEF.ImportByOrdinal:=True;
  1556. DllImport_COMENT_IMPDEF.Ordinal:=ordnr;
  1557. end;
  1558. DllImport_COMENT:=TOmfRecord_COMENT.Create;
  1559. DllImport_COMENT_IMPDEF.EncodeTo(DllImport_COMENT);
  1560. FreeAndNil(DllImport_COMENT_IMPDEF);
  1561. DllImport_COMENT.EncodeTo(RawRecord);
  1562. FreeAndNil(DllImport_COMENT);
  1563. RawRecord.WriteTo(FWriter);
  1564. { write MODEND record }
  1565. ModEnd:=TOmfRecord_MODEND.Create;
  1566. ModEnd.EncodeTo(RawRecord);
  1567. RawRecord.WriteTo(FWriter);
  1568. ModEnd.Free;
  1569. RawRecord.Free;
  1570. end;
  1571. {****************************************************************************
  1572. TOmfObjInput
  1573. ****************************************************************************}
  1574. function TOmfObjInput.PeekNextRecordType: Byte;
  1575. var
  1576. OldPos: LongInt;
  1577. begin
  1578. OldPos:=FReader.Pos;
  1579. if not FReader.read(Result, 1) then
  1580. begin
  1581. InputError('Unexpected end of file');
  1582. Result:=0;
  1583. exit;
  1584. end;
  1585. FReader.seek(OldPos);
  1586. end;
  1587. function TOmfObjInput.ReadLNames(RawRec: TOmfRawRecord): Boolean;
  1588. var
  1589. LNamesRec: TOmfRecord_LNAMES;
  1590. begin
  1591. Result:=False;
  1592. LNamesRec:=TOmfRecord_LNAMES.Create;
  1593. LNamesRec.Names:=LNames;
  1594. LNamesRec.DecodeFrom(RawRec);
  1595. LNamesRec.Free;
  1596. Result:=True;
  1597. end;
  1598. function TOmfObjInput.ReadSegDef(RawRec: TOmfRawRecord; objdata: TObjData): Boolean;
  1599. var
  1600. SegDefRec: TOmfRecord_SEGDEF;
  1601. SegmentName,SegClassName,OverlayName: string;
  1602. SecAlign: LongInt;
  1603. secoptions: TObjSectionOptions;
  1604. objsec: TOmfObjSection;
  1605. begin
  1606. Result:=False;
  1607. SegDefRec:=TOmfRecord_SEGDEF.Create;
  1608. SegDefRec.DecodeFrom(RawRec);
  1609. if (SegDefRec.SegmentNameIndex<1) or (SegDefRec.SegmentNameIndex>LNames.Count) then
  1610. begin
  1611. InputError('Segment name index out of range');
  1612. SegDefRec.Free;
  1613. exit;
  1614. end;
  1615. SegmentName:=LNames[SegDefRec.SegmentNameIndex];
  1616. if (SegDefRec.ClassNameIndex<1) or (SegDefRec.ClassNameIndex>LNames.Count) then
  1617. begin
  1618. InputError('Segment class name index out of range');
  1619. SegDefRec.Free;
  1620. exit;
  1621. end;
  1622. SegClassName:=LNames[SegDefRec.ClassNameIndex];
  1623. if (SegDefRec.OverlayNameIndex<1) or (SegDefRec.OverlayNameIndex>LNames.Count) then
  1624. begin
  1625. InputError('Segment overlay name index out of range');
  1626. SegDefRec.Free;
  1627. exit;
  1628. end;
  1629. OverlayName:=LNames[SegDefRec.OverlayNameIndex];
  1630. SecAlign:=1; // otherwise warning prohibits compilation
  1631. case SegDefRec.Alignment of
  1632. saRelocatableByteAligned:
  1633. SecAlign:=1;
  1634. saRelocatableWordAligned:
  1635. SecAlign:=2;
  1636. saRelocatableParaAligned:
  1637. SecAlign:=16;
  1638. saRelocatableDWordAligned:
  1639. SecAlign:=4;
  1640. saRelocatablePageAligned:
  1641. SecAlign:=256;
  1642. saNotSupported:
  1643. SecAlign:=4096;
  1644. saAbsolute:
  1645. begin
  1646. InputError('Absolute segment alignment not supported');
  1647. SegDefRec.Free;
  1648. exit;
  1649. end;
  1650. saNotDefined:
  1651. begin
  1652. InputError('Invalid (unsupported/undefined) OMF segment alignment');
  1653. SegDefRec.Free;
  1654. exit;
  1655. end;
  1656. end;
  1657. if not CaseSensitiveSegments then
  1658. begin
  1659. SegmentName:=UpCase(SegmentName);
  1660. SegClassName:=UpCase(SegClassName);
  1661. OverlayName:=UpCase(OverlayName);
  1662. end;
  1663. { hack for supporting object modules, generated by Borland's BINOBJ tool }
  1664. if (SegClassName='') and (SegmentName='CODE') then
  1665. begin
  1666. SegmentName:=InputFileName;
  1667. SegClassName:='CODE';
  1668. end;
  1669. secoptions:=[];
  1670. objsec:=TOmfObjSection(objdata.createsection(SegmentName+'||'+SegClassName,SecAlign,secoptions,false));
  1671. objsec.FClassName:=SegClassName;
  1672. objsec.FOverlayName:=OverlayName;
  1673. objsec.FCombination:=SegDefRec.Combination;
  1674. objsec.FUse:=SegDefRec.Use;
  1675. if SegDefRec.SegmentLength>High(objsec.Size) then
  1676. begin
  1677. InputError('Segment too large');
  1678. SegDefRec.Free;
  1679. exit;
  1680. end;
  1681. objsec.Size:=SegDefRec.SegmentLength;
  1682. if SegClassName='DWARF' then
  1683. objsec.SecOptions:=objsec.SecOptions+[oso_debug];
  1684. if (SegClassName='HEAP') or
  1685. (SegClassName='STACK') or (SegDefRec.Combination=scStack) or
  1686. (SegClassName='BEGDATA') or
  1687. (SegmentName='FPC') then
  1688. objsec.SecOptions:=objsec.SecOptions+[oso_keep];
  1689. SegDefRec.Free;
  1690. Result:=True;
  1691. end;
  1692. function TOmfObjInput.ReadGrpDef(RawRec: TOmfRawRecord; objdata: TObjData): Boolean;
  1693. var
  1694. GrpDefRec: TOmfRecord_GRPDEF;
  1695. GroupName: string;
  1696. SecGroup: TObjSectionGroup;
  1697. i,SegIndex: Integer;
  1698. begin
  1699. Result:=False;
  1700. GrpDefRec:=TOmfRecord_GRPDEF.Create;
  1701. GrpDefRec.DecodeFrom(RawRec);
  1702. if (GrpDefRec.GroupNameIndex<1) or (GrpDefRec.GroupNameIndex>LNames.Count) then
  1703. begin
  1704. InputError('Group name index out of range');
  1705. GrpDefRec.Free;
  1706. exit;
  1707. end;
  1708. GroupName:=LNames[GrpDefRec.GroupNameIndex];
  1709. if not CaseSensitiveSegments then
  1710. GroupName:=UpCase(GroupName);
  1711. SecGroup:=objdata.createsectiongroup(GroupName);
  1712. SetLength(SecGroup.members,Length(GrpDefRec.SegmentList));
  1713. for i:=0 to Length(GrpDefRec.SegmentList)-1 do
  1714. begin
  1715. SegIndex:=GrpDefRec.SegmentList[i];
  1716. if (SegIndex<1) or (SegIndex>objdata.ObjSectionList.Count) then
  1717. begin
  1718. InputError('Segment name index out of range in group definition');
  1719. GrpDefRec.Free;
  1720. exit;
  1721. end;
  1722. SecGroup.members[i]:=TOmfObjSection(objdata.ObjSectionList[SegIndex-1]);
  1723. end;
  1724. GrpDefRec.Free;
  1725. Result:=True;
  1726. end;
  1727. function TOmfObjInput.ReadExtDef(RawRec: TOmfRawRecord; objdata: TObjData): Boolean;
  1728. var
  1729. ExtDefRec: TOmfRecord_EXTDEF;
  1730. ExtDefElem: TOmfExternalNameElement;
  1731. OldCount,NewCount,i: Integer;
  1732. objsym: TObjSymbol;
  1733. symname: TSymStr;
  1734. begin
  1735. Result:=False;
  1736. ExtDefRec:=TOmfRecord_EXTDEF.Create;
  1737. ExtDefRec.ExternalNames:=ExtDefs;
  1738. OldCount:=ExtDefs.Count;
  1739. ExtDefRec.DecodeFrom(RawRec);
  1740. NewCount:=ExtDefs.Count;
  1741. for i:=OldCount to NewCount-1 do
  1742. begin
  1743. ExtDefElem:=TOmfExternalNameElement(ExtDefs[i]);
  1744. symname:=ExtDefElem.Name;
  1745. if not CaseSensitiveSymbols then
  1746. symname:=UpCase(symname);
  1747. objsym:=objdata.CreateSymbol(symname);
  1748. objsym.bind:=AB_EXTERNAL;
  1749. objsym.typ:=AT_FUNCTION;
  1750. objsym.objsection:=nil;
  1751. objsym.offset:=0;
  1752. objsym.size:=0;
  1753. end;
  1754. ExtDefRec.Free;
  1755. Result:=True;
  1756. end;
  1757. function TOmfObjInput.ReadPubDef(RawRec: TOmfRawRecord; objdata:TObjData): Boolean;
  1758. var
  1759. PubDefRec: TOmfRecord_PUBDEF;
  1760. PubDefElem: TOmfPublicNameElement;
  1761. OldCount,NewCount,i: Integer;
  1762. basegroup: TObjSectionGroup;
  1763. objsym: TObjSymbol;
  1764. objsec: TOmfObjSection;
  1765. symname: TSymStr;
  1766. begin
  1767. Result:=False;
  1768. PubDefRec:=TOmfRecord_PUBDEF.Create;
  1769. PubDefRec.PublicNames:=PubDefs;
  1770. OldCount:=PubDefs.Count;
  1771. PubDefRec.DecodeFrom(RawRec);
  1772. NewCount:=PubDefs.Count;
  1773. if (PubDefRec.BaseGroupIndex<0) or (PubDefRec.BaseGroupIndex>objdata.GroupsList.Count) then
  1774. begin
  1775. InputError('Public symbol''s group name index out of range');
  1776. PubDefRec.Free;
  1777. exit;
  1778. end;
  1779. if PubDefRec.BaseGroupIndex<>0 then
  1780. basegroup:=TObjSectionGroup(objdata.GroupsList[PubDefRec.BaseGroupIndex-1])
  1781. else
  1782. basegroup:=nil;
  1783. if (PubDefRec.BaseSegmentIndex<0) or (PubDefRec.BaseSegmentIndex>objdata.ObjSectionList.Count) then
  1784. begin
  1785. InputError('Public symbol''s segment name index out of range');
  1786. PubDefRec.Free;
  1787. exit;
  1788. end;
  1789. if PubDefRec.BaseSegmentIndex=0 then
  1790. begin
  1791. InputError('Public symbol uses absolute addressing, which is not supported by this linker');
  1792. PubDefRec.Free;
  1793. exit;
  1794. end;
  1795. objsec:=TOmfObjSection(objdata.ObjSectionList[PubDefRec.BaseSegmentIndex-1]);
  1796. for i:=OldCount to NewCount-1 do
  1797. begin
  1798. PubDefElem:=TOmfPublicNameElement(PubDefs[i]);
  1799. symname:=PubDefElem.Name;
  1800. if not CaseSensitiveSymbols then
  1801. symname:=UpCase(symname);
  1802. objsym:=objdata.CreateSymbol(symname);
  1803. if PubDefElem.IsLocal then
  1804. objsym.bind:=AB_LOCAL
  1805. else
  1806. objsym.bind:=AB_GLOBAL;
  1807. objsym.typ:=AT_FUNCTION;
  1808. objsym.group:=basegroup;
  1809. objsym.objsection:=objsec;
  1810. objsym.offset:=PubDefElem.PublicOffset;
  1811. objsym.size:=0;
  1812. end;
  1813. PubDefRec.Free;
  1814. Result:=True;
  1815. end;
  1816. function TOmfObjInput.ReadModEnd(RawRec: TOmfRawRecord; objdata:TObjData): Boolean;
  1817. var
  1818. ModEndRec: TOmfRecord_MODEND;
  1819. objsym: TObjSymbol;
  1820. objsec: TOmfObjSection;
  1821. basegroup: TObjSectionGroup;
  1822. begin
  1823. Result:=False;
  1824. ModEndRec:=TOmfRecord_MODEND.Create;
  1825. ModEndRec.DecodeFrom(RawRec);
  1826. if ModEndRec.HasStartAddress then
  1827. begin
  1828. if not ModEndRec.LogicalStartAddress then
  1829. begin
  1830. InputError('Physical start address not supported');
  1831. ModEndRec.Free;
  1832. exit;
  1833. end;
  1834. if not (ModEndRec.TargetMethod in [ftmSegmentIndex,ftmSegmentIndexNoDisp]) then
  1835. begin
  1836. InputError('Target method for start address other than "Segment Index" is not supported');
  1837. ModEndRec.Free;
  1838. exit;
  1839. end;
  1840. if (ModEndRec.TargetDatum<1) or (ModEndRec.TargetDatum>objdata.ObjSectionList.Count) then
  1841. begin
  1842. InputError('Segment name index for start address out of range');
  1843. ModEndRec.Free;
  1844. exit;
  1845. end;
  1846. case ModEndRec.FrameMethod of
  1847. ffmSegmentIndex:
  1848. begin
  1849. if (ModEndRec.FrameDatum<1) or (ModEndRec.FrameDatum>objdata.ObjSectionList.Count) then
  1850. begin
  1851. InputError('Frame segment name index for start address out of range');
  1852. ModEndRec.Free;
  1853. exit;
  1854. end;
  1855. if ModEndRec.FrameDatum<>ModEndRec.TargetDatum then
  1856. begin
  1857. InputError('Frame segment different than target segment is not supported supported for start address');
  1858. ModEndRec.Free;
  1859. exit;
  1860. end;
  1861. basegroup:=nil;
  1862. end;
  1863. ffmGroupIndex:
  1864. begin
  1865. if (ModEndRec.FrameDatum<1) or (ModEndRec.FrameDatum>objdata.GroupsList.Count) then
  1866. begin
  1867. InputError('Frame group name index for start address out of range');
  1868. ModEndRec.Free;
  1869. exit;
  1870. end;
  1871. basegroup:=TObjSectionGroup(objdata.GroupsList[ModEndRec.FrameDatum-1]);
  1872. end;
  1873. else
  1874. begin
  1875. InputError('Frame method for start address other than "Segment Index" or "Group Index" is not supported');
  1876. ModEndRec.Free;
  1877. exit;
  1878. end;
  1879. end;
  1880. objsec:=TOmfObjSection(objdata.ObjSectionList[ModEndRec.TargetDatum-1]);
  1881. objsym:=objdata.CreateSymbol('..start');
  1882. objsym.bind:=AB_GLOBAL;
  1883. objsym.typ:=AT_FUNCTION;
  1884. objsym.group:=basegroup;
  1885. objsym.objsection:=objsec;
  1886. objsym.offset:=ModEndRec.TargetDisplacement;
  1887. objsym.size:=0;
  1888. end;
  1889. ModEndRec.Free;
  1890. Result:=True;
  1891. end;
  1892. function TOmfObjInput.ReadLeOrLiDataAndFixups(RawRec: TOmfRawRecord; objdata: TObjData): Boolean;
  1893. var
  1894. Is32Bit: Boolean;
  1895. NextOfs: Integer;
  1896. SegmentIndex: Integer;
  1897. EnumeratedDataOffset: DWord;
  1898. BlockLength: Integer;
  1899. objsec: TOmfObjSection;
  1900. FixupRawRec: TOmfRawRecord=nil;
  1901. Fixup: TOmfSubRecord_FIXUP;
  1902. Thread: TOmfSubRecord_THREAD;
  1903. FixuppWithoutLeOrLiData: Boolean=False;
  1904. begin
  1905. objsec:=nil;
  1906. EnumeratedDataOffset:=0;
  1907. Result:=False;
  1908. case RawRec.RecordType of
  1909. RT_LEDATA,RT_LEDATA32:
  1910. begin
  1911. Is32Bit:=RawRec.RecordType=RT_LEDATA32;
  1912. NextOfs:=RawRec.ReadIndexedRef(0,SegmentIndex);
  1913. if Is32Bit then
  1914. begin
  1915. if (NextOfs+3)>=RawRec.RecordLength then
  1916. internalerror(2015040504);
  1917. EnumeratedDataOffset := RawRec.RawData[NextOfs]+
  1918. (RawRec.RawData[NextOfs+1] shl 8)+
  1919. (RawRec.RawData[NextOfs+2] shl 16)+
  1920. (RawRec.RawData[NextOfs+3] shl 24);
  1921. Inc(NextOfs,4);
  1922. end
  1923. else
  1924. begin
  1925. if (NextOfs+1)>=RawRec.RecordLength then
  1926. internalerror(2015040504);
  1927. EnumeratedDataOffset := RawRec.RawData[NextOfs]+
  1928. (RawRec.RawData[NextOfs+1] shl 8);
  1929. Inc(NextOfs,2);
  1930. end;
  1931. BlockLength:=RawRec.RecordLength-NextOfs-1;
  1932. if BlockLength<0 then
  1933. internalerror(2015060501);
  1934. if BlockLength>1024 then
  1935. begin
  1936. InputError('LEDATA contains more than 1024 bytes of data');
  1937. exit;
  1938. end;
  1939. if (SegmentIndex<1) or (SegmentIndex>objdata.ObjSectionList.Count) then
  1940. begin
  1941. InputError('Segment index in LEDATA field is out of range');
  1942. exit;
  1943. end;
  1944. objsec:=TOmfObjSection(objdata.ObjSectionList[SegmentIndex-1]);
  1945. objsec.SecOptions:=objsec.SecOptions+[oso_Data];
  1946. if (objsec.Data.Size>EnumeratedDataOffset) then
  1947. begin
  1948. InputError('LEDATA enumerated data offset field out of sequence');
  1949. exit;
  1950. end;
  1951. if (EnumeratedDataOffset+BlockLength)>objsec.Size then
  1952. begin
  1953. InputError('LEDATA goes beyond the segment size declared in the SEGDEF record');
  1954. exit;
  1955. end;
  1956. objsec.Data.seek(EnumeratedDataOffset);
  1957. objsec.Data.write(RawRec.RawData[NextOfs],BlockLength);
  1958. end;
  1959. RT_LIDATA,RT_LIDATA32:
  1960. begin
  1961. InputError('LIDATA records are not supported');
  1962. exit;
  1963. end;
  1964. RT_FIXUPP,RT_FIXUPP32:
  1965. begin
  1966. FixuppWithoutLeOrLiData:=True;
  1967. { a hack, used to indicate, that we must process this record }
  1968. { (RawRec) first in the FIXUPP record processing loop that follows }
  1969. FixupRawRec:=RawRec;
  1970. end;
  1971. else
  1972. internalerror(2015040301);
  1973. end;
  1974. { also read all the FIXUPP records that may follow; }
  1975. { (FixupRawRec=RawRec) indicates that we must process RawRec first, but }
  1976. { without freeing it }
  1977. while (FixupRawRec=RawRec) or (PeekNextRecordType in [RT_FIXUPP,RT_FIXUPP32]) do
  1978. begin
  1979. if FixupRawRec<>RawRec then
  1980. begin
  1981. FixupRawRec:=TOmfRawRecord.Create;
  1982. FixupRawRec.ReadFrom(FReader);
  1983. if not FRawRecord.VerifyChecksumByte then
  1984. begin
  1985. InputError('Invalid checksum in OMF record');
  1986. FixupRawRec.Free;
  1987. exit;
  1988. end;
  1989. end;
  1990. NextOfs:=0;
  1991. Thread:=TOmfSubRecord_THREAD.Create;
  1992. Fixup:=TOmfSubRecord_FIXUP.Create;
  1993. Fixup.Is32Bit:=FixupRawRec.RecordType=RT_FIXUPP32;
  1994. Fixup.DataRecordStartOffset:=EnumeratedDataOffset;
  1995. while NextOfs<(FixupRawRec.RecordLength-1) do
  1996. begin
  1997. if (FixupRawRec.RawData[NextOfs] and $80)<>0 then
  1998. begin
  1999. { FIXUP subrecord }
  2000. if FixuppWithoutLeOrLiData then
  2001. begin
  2002. InputError('FIXUP subrecord without previous LEDATA or LIDATA record');
  2003. Fixup.Free;
  2004. Thread.Free;
  2005. if FixupRawRec<>RawRec then
  2006. FixupRawRec.Free;
  2007. exit;
  2008. end;
  2009. NextOfs:=Fixup.ReadAt(FixupRawRec,NextOfs);
  2010. Fixup.ResolveByThread(FFixupThreads);
  2011. ImportOmfFixup(objdata,objsec,Fixup);
  2012. end
  2013. else
  2014. begin
  2015. { THREAD subrecord }
  2016. NextOfs:=Thread.ReadAt(FixupRawRec,NextOfs);
  2017. Thread.ApplyTo(FFixupThreads);
  2018. end;
  2019. end;
  2020. Fixup.Free;
  2021. Thread.Free;
  2022. if FixupRawRec<>RawRec then
  2023. FixupRawRec.Free;
  2024. { always set it to null, so that we read the next record on the next }
  2025. { loop iteration (this ensures that FixupRawRec<>RawRec, without }
  2026. { freeing RawRec) }
  2027. FixupRawRec:=nil;
  2028. end;
  2029. Result:=True;
  2030. end;
  2031. function TOmfObjInput.ReadImpDef(Rec: TOmfRecord_COMENT; objdata: TObjData): Boolean;
  2032. var
  2033. ImpDefRec: TOmfRecord_COMENT_IMPDEF;
  2034. SymName: string;
  2035. begin
  2036. ImpDefRec:=TOmfRecord_COMENT_IMPDEF.Create;
  2037. ImpDefRec.DecodeFrom(Rec);
  2038. SymName:=ImpDefRec.InternalName;
  2039. if not CaseSensitiveSymbols then
  2040. SymName:=UpCase(SymName);
  2041. if ImpDefRec.ImportByOrdinal then
  2042. TOmfObjData(objdata).AddImportSymbol(MaybeAddDllExt(ImpDefRec.ModuleName),'',SymName,ImpDefRec.Ordinal,false)
  2043. else
  2044. TOmfObjData(objdata).AddImportSymbol(MaybeAddDllExt(ImpDefRec.ModuleName),ImpDefRec.Name,SymName,0,false);
  2045. Result:=True;
  2046. ImpDefRec.Free;
  2047. end;
  2048. function TOmfObjInput.ReadExpDef(Rec: TOmfRecord_COMENT; objdata: TObjData): Boolean;
  2049. var
  2050. ExpDefRec: TOmfRecord_COMENT_EXPDEF;
  2051. SymName: string;
  2052. begin
  2053. ExpDefRec:=TOmfRecord_COMENT_EXPDEF.Create;
  2054. ExpDefRec.DecodeFrom(Rec);
  2055. SymName:=ExpDefRec.InternalName;
  2056. if not CaseSensitiveSymbols then
  2057. SymName:=UpCase(SymName);
  2058. TOmfObjData(objdata).AddExportSymbol(
  2059. ExpDefRec.ExportByOrdinal,
  2060. ExpDefRec.ResidentName,
  2061. ExpDefRec.NoData,
  2062. ExpDefRec.ParmCount,
  2063. ExpDefRec.ExportedName,
  2064. SymName,
  2065. ExpDefRec.ExportOrdinal);
  2066. Result:=True;
  2067. ExpDefRec.Free;
  2068. end;
  2069. function TOmfObjInput.ImportOmfFixup(objdata: TObjData; objsec: TOmfObjSection; Fixup: TOmfSubRecord_FIXUP): Boolean;
  2070. var
  2071. reloc: TOmfRelocation;
  2072. sym: TObjSymbol;
  2073. RelocType: TObjRelocationType;
  2074. target_section: TOmfObjSection;
  2075. target_group: TObjSectionGroup;
  2076. begin
  2077. Result:=False;
  2078. { range check location }
  2079. if (Fixup.LocationOffset+Fixup.LocationSize)>objsec.Size then
  2080. begin
  2081. InputError('Fixup location exceeds the current segment boundary');
  2082. exit;
  2083. end;
  2084. { range check target datum }
  2085. case Fixup.TargetMethod of
  2086. ftmSegmentIndex:
  2087. if (Fixup.TargetDatum<1) or (Fixup.TargetDatum>objdata.ObjSectionList.Count) then
  2088. begin
  2089. InputError('Segment name index in SI(<segment name>),<displacement> fixup target is out of range');
  2090. exit;
  2091. end;
  2092. ftmSegmentIndexNoDisp:
  2093. if (Fixup.TargetDatum<1) or (Fixup.TargetDatum>objdata.ObjSectionList.Count) then
  2094. begin
  2095. InputError('Segment name index in SI(<segment name>) fixup target is out of range');
  2096. exit;
  2097. end;
  2098. ftmGroupIndex:
  2099. if (Fixup.TargetDatum<1) or (Fixup.TargetDatum>objdata.GroupsList.Count) then
  2100. begin
  2101. InputError('Group name index in GI(<group name>),<displacement> fixup target is out of range');
  2102. exit;
  2103. end;
  2104. ftmGroupIndexNoDisp:
  2105. if (Fixup.TargetDatum<1) or (Fixup.TargetDatum>objdata.GroupsList.Count) then
  2106. begin
  2107. InputError('Group name index in GI(<group name>) fixup target is out of range');
  2108. exit;
  2109. end;
  2110. ftmExternalIndex:
  2111. if (Fixup.TargetDatum<1) or (Fixup.TargetDatum>ExtDefs.Count) then
  2112. begin
  2113. InputError('External symbol name index in EI(<symbol name>),<displacement> fixup target is out of range');
  2114. exit;
  2115. end;
  2116. ftmExternalIndexNoDisp:
  2117. begin
  2118. if (Fixup.TargetDatum<1) or (Fixup.TargetDatum>ExtDefs.Count) then
  2119. begin
  2120. InputError('External symbol name index in EI(<symbol name>) fixup target is out of range');
  2121. exit;
  2122. end;
  2123. end;
  2124. else
  2125. ;
  2126. end;
  2127. { range check frame datum }
  2128. case Fixup.FrameMethod of
  2129. ffmSegmentIndex:
  2130. if (Fixup.FrameDatum<1) or (Fixup.FrameDatum>objdata.ObjSectionList.Count) then
  2131. begin
  2132. InputError('Segment name index in SI(<segment name>) fixup frame is out of range');
  2133. exit;
  2134. end;
  2135. ffmGroupIndex:
  2136. if (Fixup.FrameDatum<1) or (Fixup.FrameDatum>objdata.GroupsList.Count) then
  2137. begin
  2138. InputError('Group name index in GI(<group name>) fixup frame is out of range');
  2139. exit;
  2140. end;
  2141. ffmExternalIndex:
  2142. if (Fixup.TargetDatum<1) or (Fixup.TargetDatum>ExtDefs.Count) then
  2143. begin
  2144. InputError('External symbol name index in EI(<symbol name>) fixup frame is out of range');
  2145. exit;
  2146. end;
  2147. else
  2148. ;
  2149. end;
  2150. if Fixup.TargetMethod in [ftmExternalIndex,ftmExternalIndexNoDisp] then
  2151. begin
  2152. sym:=objdata.symbolref(TOmfExternalNameElement(ExtDefs[Fixup.TargetDatum-1]).Name);
  2153. RelocType:=RELOC_NONE;
  2154. case Fixup.LocationType of
  2155. fltOffset:
  2156. case Fixup.Mode of
  2157. fmSegmentRelative:
  2158. RelocType:=RELOC_ABSOLUTE16;
  2159. fmSelfRelative:
  2160. RelocType:=RELOC_RELATIVE16;
  2161. end;
  2162. fltOffset32:
  2163. case Fixup.Mode of
  2164. fmSegmentRelative:
  2165. RelocType:=RELOC_ABSOLUTE32;
  2166. fmSelfRelative:
  2167. RelocType:=RELOC_RELATIVE32;
  2168. end;
  2169. fltBase:
  2170. case Fixup.Mode of
  2171. fmSegmentRelative:
  2172. RelocType:=RELOC_SEG;
  2173. fmSelfRelative:
  2174. RelocType:=RELOC_SEGREL;
  2175. end;
  2176. fltFarPointer:
  2177. case Fixup.Mode of
  2178. fmSegmentRelative:
  2179. RelocType:=RELOC_FARPTR;
  2180. fmSelfRelative:
  2181. RelocType:=RELOC_FARPTR_RELATIVEOFFSET;
  2182. end;
  2183. fltFarPointer48:
  2184. case Fixup.Mode of
  2185. fmSegmentRelative:
  2186. RelocType:=RELOC_FARPTR48;
  2187. fmSelfRelative:
  2188. RelocType:=RELOC_FARPTR48_RELATIVEOFFSET;
  2189. end;
  2190. else
  2191. ;
  2192. end;
  2193. if RelocType=RELOC_NONE then
  2194. begin
  2195. InputError('Unsupported fixup location type '+tostr(Ord(Fixup.LocationType))+' with mode '+tostr(ord(Fixup.Mode))+' in external reference to '+sym.Name);
  2196. exit;
  2197. end;
  2198. reloc:=TOmfRelocation.CreateSymbol(Fixup.LocationOffset,sym,RelocType);
  2199. objsec.ObjRelocations.Add(reloc);
  2200. case Fixup.FrameMethod of
  2201. ffmTarget:
  2202. {nothing};
  2203. ffmGroupIndex:
  2204. reloc.FrameGroup:=TObjSectionGroup(objdata.GroupsList[Fixup.FrameDatum-1]).Name;
  2205. else
  2206. begin
  2207. InputError('Unsupported frame method '+IntToStr(Ord(Fixup.FrameMethod))+' in external reference to '+sym.Name);
  2208. exit;
  2209. end;
  2210. end;
  2211. if Fixup.TargetDisplacement<>0 then
  2212. begin
  2213. InputError('Unsupported nonzero target displacement '+IntToStr(Fixup.TargetDisplacement)+' in external reference to '+sym.Name);
  2214. exit;
  2215. end;
  2216. end
  2217. else if Fixup.TargetMethod in [ftmSegmentIndex,ftmSegmentIndexNoDisp] then
  2218. begin
  2219. target_section:=TOmfObjSection(objdata.ObjSectionList[Fixup.TargetDatum-1]);
  2220. RelocType:=RELOC_NONE;
  2221. case Fixup.LocationType of
  2222. fltOffset:
  2223. case Fixup.Mode of
  2224. fmSegmentRelative:
  2225. RelocType:=RELOC_ABSOLUTE16;
  2226. fmSelfRelative:
  2227. RelocType:=RELOC_RELATIVE16;
  2228. end;
  2229. fltOffset32:
  2230. case Fixup.Mode of
  2231. fmSegmentRelative:
  2232. RelocType:=RELOC_ABSOLUTE32;
  2233. fmSelfRelative:
  2234. RelocType:=RELOC_RELATIVE32;
  2235. end;
  2236. fltBase:
  2237. case Fixup.Mode of
  2238. fmSegmentRelative:
  2239. RelocType:=RELOC_SEG;
  2240. fmSelfRelative:
  2241. RelocType:=RELOC_SEGREL;
  2242. end;
  2243. fltFarPointer:
  2244. case Fixup.Mode of
  2245. fmSegmentRelative:
  2246. RelocType:=RELOC_FARPTR;
  2247. fmSelfRelative:
  2248. RelocType:=RELOC_FARPTR_RELATIVEOFFSET;
  2249. end;
  2250. fltFarPointer48:
  2251. case Fixup.Mode of
  2252. fmSegmentRelative:
  2253. RelocType:=RELOC_FARPTR48;
  2254. fmSelfRelative:
  2255. RelocType:=RELOC_FARPTR48_RELATIVEOFFSET;
  2256. end;
  2257. else
  2258. ;
  2259. end;
  2260. if RelocType=RELOC_NONE then
  2261. begin
  2262. InputError('Unsupported fixup location type '+tostr(Ord(Fixup.LocationType))+' with mode '+tostr(ord(Fixup.Mode)));
  2263. exit;
  2264. end;
  2265. reloc:=TOmfRelocation.CreateSection(Fixup.LocationOffset,target_section,RelocType);
  2266. objsec.ObjRelocations.Add(reloc);
  2267. case Fixup.FrameMethod of
  2268. ffmTarget:
  2269. {nothing};
  2270. ffmGroupIndex:
  2271. reloc.FrameGroup:=TObjSectionGroup(objdata.GroupsList[Fixup.FrameDatum-1]).Name;
  2272. else
  2273. begin
  2274. InputError('Unsupported frame method '+IntToStr(Ord(Fixup.FrameMethod))+' in reference to segment '+target_section.Name);
  2275. exit;
  2276. end;
  2277. end;
  2278. if Fixup.TargetDisplacement<>0 then
  2279. begin
  2280. InputError('Unsupported nonzero target displacement '+IntToStr(Fixup.TargetDisplacement)+' in reference to segment '+target_section.Name);
  2281. exit;
  2282. end;
  2283. end
  2284. else if Fixup.TargetMethod in [ftmGroupIndex,ftmGroupIndexNoDisp] then
  2285. begin
  2286. target_group:=TObjSectionGroup(objdata.GroupsList[Fixup.TargetDatum-1]);
  2287. RelocType:=RELOC_NONE;
  2288. case Fixup.LocationType of
  2289. fltOffset:
  2290. case Fixup.Mode of
  2291. fmSegmentRelative:
  2292. RelocType:=RELOC_ABSOLUTE16;
  2293. fmSelfRelative:
  2294. RelocType:=RELOC_RELATIVE16;
  2295. end;
  2296. fltOffset32:
  2297. case Fixup.Mode of
  2298. fmSegmentRelative:
  2299. RelocType:=RELOC_ABSOLUTE32;
  2300. fmSelfRelative:
  2301. RelocType:=RELOC_RELATIVE32;
  2302. end;
  2303. fltBase:
  2304. case Fixup.Mode of
  2305. fmSegmentRelative:
  2306. RelocType:=RELOC_SEG;
  2307. fmSelfRelative:
  2308. RelocType:=RELOC_SEGREL;
  2309. end;
  2310. fltFarPointer:
  2311. case Fixup.Mode of
  2312. fmSegmentRelative:
  2313. RelocType:=RELOC_FARPTR;
  2314. fmSelfRelative:
  2315. RelocType:=RELOC_FARPTR_RELATIVEOFFSET;
  2316. end;
  2317. fltFarPointer48:
  2318. case Fixup.Mode of
  2319. fmSegmentRelative:
  2320. RelocType:=RELOC_FARPTR48;
  2321. fmSelfRelative:
  2322. RelocType:=RELOC_FARPTR48_RELATIVEOFFSET;
  2323. end;
  2324. else
  2325. ;
  2326. end;
  2327. if RelocType=RELOC_NONE then
  2328. begin
  2329. InputError('Unsupported fixup location type '+tostr(Ord(Fixup.LocationType))+' with mode '+tostr(ord(Fixup.Mode)));
  2330. exit;
  2331. end;
  2332. reloc:=TOmfRelocation.CreateGroup(Fixup.LocationOffset,target_group,RelocType);
  2333. objsec.ObjRelocations.Add(reloc);
  2334. case Fixup.FrameMethod of
  2335. ffmTarget:
  2336. {nothing};
  2337. else
  2338. begin
  2339. InputError('Unsupported frame method '+IntToStr(Ord(Fixup.FrameMethod))+' in reference to group '+target_group.Name);
  2340. exit;
  2341. end;
  2342. end;
  2343. if Fixup.TargetDisplacement<>0 then
  2344. begin
  2345. InputError('Unsupported nonzero target displacement '+IntToStr(Fixup.TargetDisplacement)+' in reference to group '+target_group.Name);
  2346. exit;
  2347. end;
  2348. end
  2349. else
  2350. begin
  2351. {todo: convert other fixup types as well }
  2352. InputError('Unsupported fixup target method '+IntToStr(Ord(Fixup.TargetMethod)));
  2353. exit;
  2354. end;
  2355. Result:=True;
  2356. end;
  2357. constructor TOmfObjInput.create;
  2358. begin
  2359. inherited create;
  2360. cobjdata:=TOmfObjData;
  2361. FLNames:=TOmfOrderedNameCollection.Create(True);
  2362. FExtDefs:=TFPHashObjectList.Create;
  2363. FPubDefs:=TFPHashObjectList.Create;
  2364. FFixupThreads:=TOmfThreads.Create;
  2365. FRawRecord:=TOmfRawRecord.Create;
  2366. CaseSensitiveSegments:=False;
  2367. CaseSensitiveSymbols:=True;
  2368. end;
  2369. destructor TOmfObjInput.destroy;
  2370. begin
  2371. FCOMENTRecord.Free;
  2372. FRawRecord.Free;
  2373. FFixupThreads.Free;
  2374. FPubDefs.Free;
  2375. FExtDefs.Free;
  2376. FLNames.Free;
  2377. inherited destroy;
  2378. end;
  2379. class function TOmfObjInput.CanReadObjData(AReader: TObjectreader): boolean;
  2380. var
  2381. b: Byte;
  2382. begin
  2383. result:=false;
  2384. if AReader.Read(b,sizeof(b)) then
  2385. begin
  2386. if b=RT_THEADR then
  2387. { TODO: check additional fields }
  2388. result:=true;
  2389. end;
  2390. AReader.Seek(0);
  2391. end;
  2392. function TOmfObjInput.ReadObjData(AReader: TObjectreader; out objdata: TObjData): boolean;
  2393. begin
  2394. FReader:=AReader;
  2395. InputFileName:=AReader.FileName;
  2396. objdata:=CObjData.Create(InputFileName);
  2397. result:=false;
  2398. { the TOmfObjData constructor creates a group 'DGROUP', which is to be
  2399. used by the code generator, when writing files. When reading object
  2400. files, however, we need to start with an empty list of groups, so
  2401. let's clear the group list now. }
  2402. objdata.GroupsList.Clear;
  2403. LNames.Clear;
  2404. ExtDefs.Clear;
  2405. FRawRecord.ReadFrom(FReader);
  2406. if not FRawRecord.VerifyChecksumByte then
  2407. begin
  2408. InputError('Invalid checksum in OMF record');
  2409. exit;
  2410. end;
  2411. if FRawRecord.RecordType<>RT_THEADR then
  2412. begin
  2413. InputError('Can''t read OMF header');
  2414. exit;
  2415. end;
  2416. repeat
  2417. FRawRecord.ReadFrom(FReader);
  2418. if not FRawRecord.VerifyChecksumByte then
  2419. begin
  2420. InputError('Invalid checksum in OMF record');
  2421. exit;
  2422. end;
  2423. FreeAndNil(FCOMENTRecord);
  2424. case FRawRecord.RecordType of
  2425. RT_LNAMES:
  2426. if not ReadLNames(FRawRecord) then
  2427. exit;
  2428. RT_SEGDEF,RT_SEGDEF32:
  2429. if not ReadSegDef(FRawRecord,objdata) then
  2430. exit;
  2431. RT_GRPDEF:
  2432. if not ReadGrpDef(FRawRecord,objdata) then
  2433. exit;
  2434. RT_COMENT:
  2435. begin
  2436. FCOMENTRecord:=TOmfRecord_COMENT.Create;
  2437. FCOMENTRecord.DecodeFrom(FRawRecord);
  2438. case FCOMENTRecord.CommentClass of
  2439. CC_OmfExtension:
  2440. begin
  2441. if Length(FCOMENTRecord.CommentString)>=1 then
  2442. begin
  2443. case Ord(FCOMENTRecord.CommentString[1]) of
  2444. CC_OmfExtension_IMPDEF:
  2445. if not ReadImpDef(FCOMENTRecord,objdata) then
  2446. exit;
  2447. CC_OmfExtension_EXPDEF:
  2448. if not ReadExpDef(FCOMENTRecord,objdata) then
  2449. exit;
  2450. end;
  2451. end;
  2452. end;
  2453. CC_LIBMOD:
  2454. begin
  2455. {todo: do we need to read the module name here?}
  2456. end;
  2457. CC_EXESTR:
  2458. begin
  2459. InputError('EXESTR record (Executable String Record) is not supported');
  2460. exit;
  2461. end;
  2462. CC_INCERR:
  2463. begin
  2464. InputError('Invalid object file (contains indication of error encountered during incremental compilation)');
  2465. exit;
  2466. end;
  2467. CC_NOPAD:
  2468. begin
  2469. InputError('NOPAD (No Segment Padding) record is not supported');
  2470. exit;
  2471. end;
  2472. CC_WKEXT:
  2473. begin
  2474. InputError('Weak externals are not supported');
  2475. exit;
  2476. end;
  2477. CC_LZEXT:
  2478. begin
  2479. InputError('Lazy externals are not supported');
  2480. exit;
  2481. end;
  2482. else
  2483. begin
  2484. {the rest are ignored for now...}
  2485. end;
  2486. end;
  2487. end;
  2488. RT_EXTDEF:
  2489. if not ReadExtDef(FRawRecord,objdata) then
  2490. exit;
  2491. RT_LPUBDEF,RT_LPUBDEF32,
  2492. RT_PUBDEF,RT_PUBDEF32:
  2493. if not ReadPubDef(FRawRecord,objdata) then
  2494. exit;
  2495. RT_LEDATA,RT_LEDATA32,
  2496. RT_LIDATA,RT_LIDATA32,
  2497. RT_FIXUPP,RT_FIXUPP32:
  2498. if not ReadLeOrLiDataAndFixups(FRawRecord,objdata) then
  2499. exit;
  2500. RT_MODEND,RT_MODEND32:
  2501. if not ReadModEnd(FRawRecord,objdata) then
  2502. exit;
  2503. RT_LINNUM,RT_LINNUM32:
  2504. ;
  2505. else
  2506. begin
  2507. InputError('Unsupported OMF record type $'+HexStr(FRawRecord.RecordType,2));
  2508. exit;
  2509. end;
  2510. end;
  2511. until FRawRecord.RecordType in [RT_MODEND,RT_MODEND32];
  2512. result:=true;
  2513. end;
  2514. {****************************************************************************
  2515. TMZExeHeader
  2516. ****************************************************************************}
  2517. procedure TMZExeHeader.SetHeaderSizeAlignment(AValue: Integer);
  2518. begin
  2519. if (AValue<16) or ((AValue mod 16) <> 0) then
  2520. Internalerror(2015060601);
  2521. FHeaderSizeAlignment:=AValue;
  2522. end;
  2523. constructor TMZExeHeader.Create;
  2524. begin
  2525. FHeaderSizeAlignment:=16;
  2526. end;
  2527. procedure TMZExeHeader.WriteTo(aWriter: TObjectWriter);
  2528. var
  2529. NumRelocs: Word;
  2530. HeaderSizeInBytes: DWord;
  2531. HeaderParagraphs: Word;
  2532. RelocTableOffset: Word;
  2533. BytesInLastBlock: Word;
  2534. BlocksInFile: Word;
  2535. HeaderBytes: array [0..$1B] of Byte;
  2536. RelocBytes: array [0..3] of Byte;
  2537. TotalExeSize: DWord;
  2538. i: Integer;
  2539. begin
  2540. NumRelocs:=Length(Relocations);
  2541. RelocTableOffset:=$1C+Length(ExtraHeaderData);
  2542. HeaderSizeInBytes:=Align(RelocTableOffset+4*NumRelocs,16);
  2543. HeaderParagraphs:=HeaderSizeInBytes div 16;
  2544. TotalExeSize:=HeaderSizeInBytes+LoadableImageSize;
  2545. BlocksInFile:=(TotalExeSize+511) div 512;
  2546. BytesInLastBlock:=TotalExeSize mod 512;
  2547. HeaderBytes[$00]:=$4D; { 'M' }
  2548. HeaderBytes[$01]:=$5A; { 'Z' }
  2549. HeaderBytes[$02]:=Byte(BytesInLastBlock);
  2550. HeaderBytes[$03]:=Byte(BytesInLastBlock shr 8);
  2551. HeaderBytes[$04]:=Byte(BlocksInFile);
  2552. HeaderBytes[$05]:=Byte(BlocksInFile shr 8);
  2553. HeaderBytes[$06]:=Byte(NumRelocs);
  2554. HeaderBytes[$07]:=Byte(NumRelocs shr 8);
  2555. HeaderBytes[$08]:=Byte(HeaderParagraphs);
  2556. HeaderBytes[$09]:=Byte(HeaderParagraphs shr 8);
  2557. HeaderBytes[$0A]:=Byte(MinExtraParagraphs);
  2558. HeaderBytes[$0B]:=Byte(MinExtraParagraphs shr 8);
  2559. HeaderBytes[$0C]:=Byte(MaxExtraParagraphs);
  2560. HeaderBytes[$0D]:=Byte(MaxExtraParagraphs shr 8);
  2561. HeaderBytes[$0E]:=Byte(InitialSS);
  2562. HeaderBytes[$0F]:=Byte(InitialSS shr 8);
  2563. HeaderBytes[$10]:=Byte(InitialSP);
  2564. HeaderBytes[$11]:=Byte(InitialSP shr 8);
  2565. HeaderBytes[$12]:=Byte(Checksum);
  2566. HeaderBytes[$13]:=Byte(Checksum shr 8);
  2567. HeaderBytes[$14]:=Byte(InitialIP);
  2568. HeaderBytes[$15]:=Byte(InitialIP shr 8);
  2569. HeaderBytes[$16]:=Byte(InitialCS);
  2570. HeaderBytes[$17]:=Byte(InitialCS shr 8);
  2571. HeaderBytes[$18]:=Byte(RelocTableOffset);
  2572. HeaderBytes[$19]:=Byte(RelocTableOffset shr 8);
  2573. HeaderBytes[$1A]:=Byte(OverlayNumber);
  2574. HeaderBytes[$1B]:=Byte(OverlayNumber shr 8);
  2575. aWriter.write(HeaderBytes[0],$1C);
  2576. aWriter.write(ExtraHeaderData[0],Length(ExtraHeaderData));
  2577. for i:=0 to NumRelocs-1 do
  2578. with Relocations[i] do
  2579. begin
  2580. RelocBytes[0]:=Byte(offset);
  2581. RelocBytes[1]:=Byte(offset shr 8);
  2582. RelocBytes[2]:=Byte(segment);
  2583. RelocBytes[3]:=Byte(segment shr 8);
  2584. aWriter.write(RelocBytes[0],4);
  2585. end;
  2586. { pad with zeros until the end of header (paragraph aligned) }
  2587. aWriter.WriteZeros(HeaderSizeInBytes-aWriter.Size);
  2588. end;
  2589. procedure TMZExeHeader.AddRelocation(aSegment, aOffset: Word);
  2590. begin
  2591. SetLength(FRelocations,Length(FRelocations)+1);
  2592. with FRelocations[High(FRelocations)] do
  2593. begin
  2594. segment:=aSegment;
  2595. offset:=aOffset;
  2596. end;
  2597. end;
  2598. {****************************************************************************
  2599. TMZExeSection
  2600. ****************************************************************************}
  2601. procedure TMZExeSection.AddObjSection(objsec: TObjSection; ignoreprops: boolean);
  2602. begin
  2603. { allow mixing initialized and uninitialized data in the same section
  2604. => set ignoreprops=true }
  2605. inherited AddObjSection(objsec,true);
  2606. end;
  2607. {****************************************************************************
  2608. TMZExeUnifiedLogicalSegment
  2609. ****************************************************************************}
  2610. constructor TMZExeUnifiedLogicalSegment.create(HashObjectList: TFPHashObjectList; const s: TSymStr);
  2611. var
  2612. Separator: SizeInt;
  2613. begin
  2614. inherited create(HashObjectList,s);
  2615. FObjSectionList:=TFPObjectList.Create(false);
  2616. { name format is 'SegName||ClassName' }
  2617. Separator:=Pos('||',s);
  2618. if Separator>0 then
  2619. begin
  2620. FSegName:=Copy(s,1,Separator-1);
  2621. FSegClass:=Copy(s,Separator+2,Length(s)-Separator-1);
  2622. end
  2623. else
  2624. begin
  2625. FSegName:=Name;
  2626. FSegClass:='';
  2627. end;
  2628. { wlink recognizes the stack segment by the class name 'STACK' }
  2629. { let's be compatible with wlink }
  2630. IsStack:=FSegClass='STACK';
  2631. end;
  2632. destructor TMZExeUnifiedLogicalSegment.destroy;
  2633. begin
  2634. FObjSectionList.Free;
  2635. inherited destroy;
  2636. end;
  2637. procedure TMZExeUnifiedLogicalSegment.AddObjSection(ObjSec: TOmfObjSection);
  2638. begin
  2639. ObjSectionList.Add(ObjSec);
  2640. ObjSec.MZExeUnifiedLogicalSegment:=self;
  2641. { tlink (and ms link?) use the scStack segment combination to recognize
  2642. the stack segment.
  2643. let's be compatible with tlink as well }
  2644. if ObjSec.Combination=scStack then
  2645. IsStack:=True;
  2646. end;
  2647. procedure TMZExeUnifiedLogicalSegment.CalcMemPos;
  2648. var
  2649. MinMemPos: qword=high(qword);
  2650. MaxMemPos: qword=0;
  2651. objsec: TOmfObjSection;
  2652. i: Integer;
  2653. begin
  2654. if ObjSectionList.Count=0 then
  2655. internalerror(2015082201);
  2656. for i:=0 to ObjSectionList.Count-1 do
  2657. begin
  2658. objsec:=TOmfObjSection(ObjSectionList[i]);
  2659. if objsec.MemPos<MinMemPos then
  2660. MinMemPos:=objsec.MemPos;
  2661. if (objsec.MemPos+objsec.Size)>MaxMemPos then
  2662. MaxMemPos:=objsec.MemPos+objsec.Size;
  2663. end;
  2664. MemPos:=MinMemPos;
  2665. Size:=MaxMemPos-MemPos;
  2666. end;
  2667. function TMZExeUnifiedLogicalSegment.MemPosStr: string;
  2668. begin
  2669. Result:=HexStr(MemBasePos shr 4,4)+':'+HexStr((MemPos-MemBasePos),4);
  2670. end;
  2671. {****************************************************************************
  2672. TMZExeUnifiedLogicalGroup
  2673. ****************************************************************************}
  2674. constructor TMZExeUnifiedLogicalGroup.create(HashObjectList: TFPHashObjectList; const s: TSymStr);
  2675. begin
  2676. inherited create(HashObjectList,s);
  2677. FSegmentList:=TFPHashObjectList.Create(false);
  2678. end;
  2679. destructor TMZExeUnifiedLogicalGroup.destroy;
  2680. begin
  2681. FSegmentList.Free;
  2682. inherited destroy;
  2683. end;
  2684. procedure TMZExeUnifiedLogicalGroup.CalcMemPos;
  2685. var
  2686. MinMemPos: qword=high(qword);
  2687. MaxMemPos: qword=0;
  2688. UniSeg: TMZExeUnifiedLogicalSegment;
  2689. i: Integer;
  2690. begin
  2691. if SegmentList.Count=0 then
  2692. internalerror(2015082201);
  2693. for i:=0 to SegmentList.Count-1 do
  2694. begin
  2695. UniSeg:=TMZExeUnifiedLogicalSegment(SegmentList[i]);
  2696. if UniSeg.MemPos<MinMemPos then
  2697. MinMemPos:=UniSeg.MemPos;
  2698. if (UniSeg.MemPos+UniSeg.Size)>MaxMemPos then
  2699. MaxMemPos:=UniSeg.MemPos+UniSeg.Size;
  2700. end;
  2701. { align *down* on a paragraph boundary }
  2702. MemPos:=(MinMemPos shr 4) shl 4;
  2703. Size:=MaxMemPos-MemPos;
  2704. end;
  2705. function TMZExeUnifiedLogicalGroup.MemPosStr: string;
  2706. begin
  2707. Result:=HexStr(MemPos shr 4,4)+':'+HexStr(MemPos and $f,4);
  2708. end;
  2709. procedure TMZExeUnifiedLogicalGroup.AddSegment(UniSeg: TMZExeUnifiedLogicalSegment);
  2710. begin
  2711. SegmentList.Add(UniSeg.Name,UniSeg);
  2712. if UniSeg.PrimaryGroup='' then
  2713. UniSeg.PrimaryGroup:=Name;
  2714. end;
  2715. {****************************************************************************
  2716. TMZExeOutput
  2717. ****************************************************************************}
  2718. function TMZExeOutput.GetMZFlatContentSection: TMZExeSection;
  2719. begin
  2720. if not assigned(FMZFlatContentSection) then
  2721. FMZFlatContentSection:=TMZExeSection(FindExeSection('.MZ_flat_content'));
  2722. result:=FMZFlatContentSection;
  2723. end;
  2724. procedure TMZExeOutput.CalcDwarfUnifiedLogicalSegmentsForSection(const SecName: TSymStr);
  2725. var
  2726. ExeSec: TMZExeSection;
  2727. ObjSec: TOmfObjSection;
  2728. UniSeg: TMZExeUnifiedLogicalSegment;
  2729. i: Integer;
  2730. begin
  2731. ExeSec:=TMZExeSection(FindExeSection(SecName));
  2732. for i:=0 to ExeSec.ObjSectionList.Count-1 do
  2733. begin
  2734. ObjSec:=TOmfObjSection(ExeSec.ObjSectionList[i]);
  2735. UniSeg:=TMZExeUnifiedLogicalSegment(DwarfUnifiedLogicalSegments.Find(ObjSec.Name));
  2736. if not assigned(UniSeg) then
  2737. begin
  2738. UniSeg:=TMZExeUnifiedLogicalSegment.Create(DwarfUnifiedLogicalSegments,ObjSec.Name);
  2739. UniSeg.MemPos:=0;
  2740. end;
  2741. UniSeg.AddObjSection(ObjSec);
  2742. end;
  2743. for i:=0 to DwarfUnifiedLogicalSegments.Count-1 do
  2744. begin
  2745. UniSeg:=TMZExeUnifiedLogicalSegment(DwarfUnifiedLogicalSegments[i]);
  2746. UniSeg.CalcMemPos;
  2747. end;
  2748. end;
  2749. procedure TMZExeOutput.CalcExeUnifiedLogicalSegments;
  2750. var
  2751. ExeSec: TMZExeSection;
  2752. ObjSec: TOmfObjSection;
  2753. UniSeg: TMZExeUnifiedLogicalSegment;
  2754. i: Integer;
  2755. begin
  2756. ExeSec:=MZFlatContentSection;
  2757. for i:=0 to ExeSec.ObjSectionList.Count-1 do
  2758. begin
  2759. ObjSec:=TOmfObjSection(ExeSec.ObjSectionList[i]);
  2760. UniSeg:=TMZExeUnifiedLogicalSegment(ExeUnifiedLogicalSegments.Find(ObjSec.Name));
  2761. if not assigned(UniSeg) then
  2762. UniSeg:=TMZExeUnifiedLogicalSegment.Create(ExeUnifiedLogicalSegments,ObjSec.Name);
  2763. UniSeg.AddObjSection(ObjSec);
  2764. end;
  2765. for i:=0 to ExeUnifiedLogicalSegments.Count-1 do
  2766. begin
  2767. UniSeg:=TMZExeUnifiedLogicalSegment(ExeUnifiedLogicalSegments[i]);
  2768. UniSeg.CalcMemPos;
  2769. if UniSeg.Size>$10000 then
  2770. begin
  2771. if current_settings.x86memorymodel=mm_tiny then
  2772. Message1(link_e_program_segment_too_large,IntToStr(UniSeg.Size-$10000))
  2773. else if UniSeg.SegClass='CODE' then
  2774. Message2(link_e_code_segment_too_large,UniSeg.SegName,IntToStr(UniSeg.Size-$10000))
  2775. else if UniSeg.SegClass='DATA' then
  2776. Message2(link_e_data_segment_too_large,UniSeg.SegName,IntToStr(UniSeg.Size-$10000))
  2777. else
  2778. Message2(link_e_segment_too_large,UniSeg.SegName,IntToStr(UniSeg.Size-$10000)+' '+UniSeg.SegName);
  2779. end;
  2780. end;
  2781. end;
  2782. procedure TMZExeOutput.CalcExeGroups;
  2783. procedure AddToGroup(UniSeg:TMZExeUnifiedLogicalSegment;GroupName:TSymStr);
  2784. var
  2785. Group: TMZExeUnifiedLogicalGroup;
  2786. begin
  2787. Group:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups.Find(GroupName));
  2788. if not assigned(Group) then
  2789. Group:=TMZExeUnifiedLogicalGroup.Create(ExeUnifiedLogicalGroups,GroupName);
  2790. Group.AddSegment(UniSeg);
  2791. end;
  2792. var
  2793. objdataidx,groupidx,secidx: Integer;
  2794. ObjData: TObjData;
  2795. ObjGroup: TObjSectionGroup;
  2796. ObjSec: TOmfObjSection;
  2797. UniGrp: TMZExeUnifiedLogicalGroup;
  2798. begin
  2799. for objdataidx:=0 to ObjDataList.Count-1 do
  2800. begin
  2801. ObjData:=TObjData(ObjDataList[objdataidx]);
  2802. if assigned(ObjData.GroupsList) then
  2803. for groupidx:=0 to ObjData.GroupsList.Count-1 do
  2804. begin
  2805. ObjGroup:=TObjSectionGroup(ObjData.GroupsList[groupidx]);
  2806. for secidx:=low(ObjGroup.members) to high(ObjGroup.members) do
  2807. begin
  2808. ObjSec:=TOmfObjSection(ObjGroup.members[secidx]);
  2809. if assigned(ObjSec.MZExeUnifiedLogicalSegment) then
  2810. AddToGroup(ObjSec.MZExeUnifiedLogicalSegment,ObjGroup.Name);
  2811. end;
  2812. end;
  2813. end;
  2814. for groupidx:=0 to ExeUnifiedLogicalGroups.Count-1 do
  2815. begin
  2816. UniGrp:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups[groupidx]);
  2817. UniGrp.CalcMemPos;
  2818. if UniGrp.Size>$10000 then
  2819. begin
  2820. if current_settings.x86memorymodel=mm_tiny then
  2821. Message1(link_e_program_segment_too_large,IntToStr(UniGrp.Size-$10000))
  2822. else if UniGrp.Name='DGROUP' then
  2823. Message2(link_e_data_segment_too_large,UniGrp.Name,IntToStr(UniGrp.Size-$10000))
  2824. else
  2825. Message2(link_e_group_too_large,UniGrp.Name,IntToStr(UniGrp.Size-$10000));
  2826. end;
  2827. end;
  2828. end;
  2829. procedure TMZExeOutput.CalcSegments_MemBasePos;
  2830. var
  2831. lastbase:qword=0;
  2832. i: Integer;
  2833. UniSeg: TMZExeUnifiedLogicalSegment;
  2834. begin
  2835. for i:=0 to ExeUnifiedLogicalSegments.Count-1 do
  2836. begin
  2837. UniSeg:=TMZExeUnifiedLogicalSegment(ExeUnifiedLogicalSegments[i]);
  2838. if (UniSeg.PrimaryGroup<>'') or (UniSeg.IsStack) or
  2839. (((UniSeg.MemPos+UniSeg.Size-1)-lastbase)>$ffff) then
  2840. lastbase:=(UniSeg.MemPos shr 4) shl 4;
  2841. UniSeg.MemBasePos:=lastbase;
  2842. end;
  2843. end;
  2844. procedure TMZExeOutput.WriteMap_SegmentsAndGroups;
  2845. var
  2846. i, LongestGroupName, LongestSegmentName, LongestClassName: Integer;
  2847. UniSeg: TMZExeUnifiedLogicalSegment;
  2848. UniGrp: TMZExeUnifiedLogicalGroup;
  2849. GroupColumnSize, SegmentColumnSize, ClassColumnSize: LongInt;
  2850. begin
  2851. LongestGroupName:=0;
  2852. for i:=0 to ExeUnifiedLogicalGroups.Count-1 do
  2853. begin
  2854. UniGrp:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups[i]);
  2855. LongestGroupName:=max(LongestGroupName,Length(UniGrp.Name));
  2856. end;
  2857. LongestSegmentName:=0;
  2858. LongestClassName:=0;
  2859. for i:=0 to ExeUnifiedLogicalSegments.Count-1 do
  2860. begin
  2861. UniSeg:=TMZExeUnifiedLogicalSegment(ExeUnifiedLogicalSegments[i]);
  2862. LongestSegmentName:=max(LongestSegmentName,Length(UniSeg.SegName));
  2863. LongestClassName:=max(LongestClassName,Length(UniSeg.SegClass));
  2864. end;
  2865. GroupColumnSize:=max(32,LongestGroupName+1);
  2866. SegmentColumnSize:=max(23,LongestSegmentName+1);
  2867. ClassColumnSize:=max(15,LongestClassName+1);
  2868. exemap.AddHeader('Groups list');
  2869. exemap.Add('');
  2870. exemap.Add(PadSpace('Group',GroupColumnSize)+PadSpace('Address',21)+'Size');
  2871. exemap.Add(PadSpace('=====',GroupColumnSize)+PadSpace('=======',21)+'====');
  2872. exemap.Add('');
  2873. for i:=0 to ExeUnifiedLogicalGroups.Count-1 do
  2874. begin
  2875. UniGrp:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups[i]);
  2876. exemap.Add(PadSpace(UniGrp.Name,GroupColumnSize)+PadSpace(UniGrp.MemPosStr,21)+HexStr(UniGrp.Size,8));
  2877. end;
  2878. exemap.Add('');
  2879. GroupColumnSize:=max(15,LongestGroupName+1);
  2880. exemap.AddHeader('Segments list');
  2881. exemap.Add('');
  2882. exemap.Add(PadSpace('Segment',SegmentColumnSize)+PadSpace('Class',ClassColumnSize)+PadSpace('Group',GroupColumnSize)+PadSpace('Address',16)+'Size');
  2883. exemap.Add(PadSpace('=======',SegmentColumnSize)+PadSpace('=====',ClassColumnSize)+PadSpace('=====',GroupColumnSize)+PadSpace('=======',16)+'====');
  2884. exemap.Add('');
  2885. for i:=0 to ExeUnifiedLogicalSegments.Count-1 do
  2886. begin
  2887. UniSeg:=TMZExeUnifiedLogicalSegment(ExeUnifiedLogicalSegments[i]);
  2888. exemap.Add(PadSpace(UniSeg.SegName,SegmentColumnSize)+PadSpace(UniSeg.SegClass,ClassColumnSize)+PadSpace(UniSeg.PrimaryGroup,GroupColumnSize)+PadSpace(UniSeg.MemPosStr,16)+HexStr(UniSeg.Size,8));
  2889. end;
  2890. exemap.Add('');
  2891. end;
  2892. procedure TMZExeOutput.WriteMap_HeaderData;
  2893. begin
  2894. exemap.AddHeader('Header data');
  2895. exemap.Add('Loadable image size: '+HexStr(Header.LoadableImageSize,8));
  2896. exemap.Add('Min extra paragraphs: '+HexStr(Header.MinExtraParagraphs,4));
  2897. exemap.Add('Max extra paragraphs: '+HexStr(Header.MaxExtraParagraphs,4));
  2898. exemap.Add('Initial stack pointer: '+HexStr(Header.InitialSS,4)+':'+HexStr(Header.InitialSP,4));
  2899. exemap.Add('Entry point address: '+HexStr(Header.InitialCS,4)+':'+HexStr(Header.InitialIP,4));
  2900. end;
  2901. function TMZExeOutput.FindStackSegment: TMZExeUnifiedLogicalSegment;
  2902. var
  2903. i: Integer;
  2904. stackseg_wannabe: TMZExeUnifiedLogicalSegment;
  2905. begin
  2906. Result:=nil;
  2907. for i:=0 to ExeUnifiedLogicalSegments.Count-1 do
  2908. begin
  2909. stackseg_wannabe:=TMZExeUnifiedLogicalSegment(ExeUnifiedLogicalSegments[i]);
  2910. { if there are multiple stack segments, choose the largest one.
  2911. In theory, we're probably supposed to combine them all and put
  2912. them in a contiguous location in memory, but we don't care }
  2913. if stackseg_wannabe.IsStack and
  2914. (not assigned(result) or (Result.Size<stackseg_wannabe.Size)) then
  2915. Result:=stackseg_wannabe;
  2916. end;
  2917. end;
  2918. procedure TMZExeOutput.FillLoadableImageSize;
  2919. var
  2920. i: Integer;
  2921. ExeSec: TMZExeSection;
  2922. ObjSec: TOmfObjSection;
  2923. StartDataPos: LongWord;
  2924. buf: array [0..1023] of byte;
  2925. bytesread: LongWord;
  2926. begin
  2927. Header.LoadableImageSize:=0;
  2928. ExeSec:=MZFlatContentSection;
  2929. for i:=0 to ExeSec.ObjSectionList.Count-1 do
  2930. begin
  2931. ObjSec:=TOmfObjSection(ExeSec.ObjSectionList[i]);
  2932. if (ObjSec.Size>0) and assigned(ObjSec.Data) then
  2933. if (ObjSec.MemPos+ObjSec.Size)>Header.LoadableImageSize then
  2934. Header.LoadableImageSize:=ObjSec.MemPos+ObjSec.Size;
  2935. end;
  2936. end;
  2937. procedure TMZExeOutput.FillMinExtraParagraphs;
  2938. var
  2939. ExeSec: TMZExeSection;
  2940. begin
  2941. ExeSec:=MZFlatContentSection;
  2942. Header.MinExtraParagraphs:=(align(ExeSec.Size,16)-align(Header.LoadableImageSize,16)) div 16;
  2943. end;
  2944. procedure TMZExeOutput.FillMaxExtraParagraphs;
  2945. var
  2946. heapmin_paragraphs: Integer;
  2947. heapmax_paragraphs: Integer;
  2948. begin
  2949. if current_settings.x86memorymodel in x86_far_data_models then
  2950. begin
  2951. { calculate the additional number of paragraphs needed }
  2952. heapmin_paragraphs:=(heapsize + 15) div 16;
  2953. heapmax_paragraphs:=(maxheapsize + 15) div 16;
  2954. Header.MaxExtraParagraphs:=min(Header.MinExtraParagraphs-heapmin_paragraphs+heapmax_paragraphs,$FFFF);
  2955. end
  2956. else
  2957. Header.MaxExtraParagraphs:=$FFFF;
  2958. end;
  2959. procedure TMZExeOutput.FillStartAddress;
  2960. var
  2961. EntryMemPos: qword;
  2962. EntryMemBasePos: qword;
  2963. begin
  2964. EntryMemPos:=EntrySym.address;
  2965. if assigned(EntrySym.group) then
  2966. EntryMemBasePos:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups.Find(EntrySym.group.Name)).MemPos
  2967. else
  2968. EntryMemBasePos:=TOmfObjSection(EntrySym.objsection).MZExeUnifiedLogicalSegment.MemBasePos;
  2969. Header.InitialIP:=EntryMemPos-EntryMemBasePos;
  2970. Header.InitialCS:=EntryMemBasePos shr 4;
  2971. end;
  2972. procedure TMZExeOutput.FillStackAddress;
  2973. var
  2974. stackseg: TMZExeUnifiedLogicalSegment;
  2975. begin
  2976. stackseg:=FindStackSegment;
  2977. if assigned(stackseg) then
  2978. begin
  2979. Header.InitialSS:=stackseg.MemBasePos shr 4;
  2980. Header.InitialSP:=stackseg.MemPos+stackseg.Size-stackseg.MemBasePos;
  2981. end
  2982. else
  2983. begin
  2984. Header.InitialSS:=0;
  2985. Header.InitialSP:=0;
  2986. end;
  2987. end;
  2988. procedure TMZExeOutput.FillHeaderData;
  2989. begin
  2990. Header.MaxExtraParagraphs:=$FFFF;
  2991. FillLoadableImageSize;
  2992. FillMinExtraParagraphs;
  2993. FillMaxExtraParagraphs;
  2994. FillStartAddress;
  2995. FillStackAddress;
  2996. if assigned(exemap) then
  2997. WriteMap_HeaderData;
  2998. end;
  2999. function TMZExeOutput.writeExe: boolean;
  3000. var
  3001. ExeSec: TMZExeSection;
  3002. i: Integer;
  3003. ObjSec: TOmfObjSection;
  3004. begin
  3005. Result:=False;
  3006. FillHeaderData;
  3007. Header.WriteTo(FWriter);
  3008. ExeSec:=MZFlatContentSection;
  3009. ExeSec.DataPos:=FWriter.Size;
  3010. for i:=0 to ExeSec.ObjSectionList.Count-1 do
  3011. begin
  3012. ObjSec:=TOmfObjSection(ExeSec.ObjSectionList[i]);
  3013. if ObjSec.MemPos<Header.LoadableImageSize then
  3014. begin
  3015. FWriter.WriteZeros(max(0,ObjSec.MemPos-FWriter.Size+ExeSec.DataPos));
  3016. if assigned(ObjSec.Data) then
  3017. FWriter.writearray(ObjSec.Data);
  3018. end;
  3019. end;
  3020. Result:=True;
  3021. end;
  3022. function TMZExeOutput.writeCom: boolean;
  3023. const
  3024. ComFileOffset=$100;
  3025. var
  3026. i: Integer;
  3027. ExeSec: TMZExeSection;
  3028. ObjSec: TOmfObjSection;
  3029. StartDataPos: LongWord;
  3030. buf: array [0..1023] of byte;
  3031. bytesread: LongWord;
  3032. begin
  3033. FillHeaderData;
  3034. if Length(Header.Relocations)>0 then
  3035. begin
  3036. Message(link_e_com_program_uses_segment_relocations);
  3037. exit(False);
  3038. end;
  3039. ExeSec:=MZFlatContentSection;
  3040. for i:=0 to ExeSec.ObjSectionList.Count-1 do
  3041. begin
  3042. ObjSec:=TOmfObjSection(ExeSec.ObjSectionList[i]);
  3043. if ObjSec.MemPos<Header.LoadableImageSize then
  3044. begin
  3045. FWriter.WriteZeros(max(0,int64(ObjSec.MemPos)-ComFileOffset-int64(FWriter.Size)));
  3046. if assigned(ObjSec.Data) then
  3047. begin
  3048. if ObjSec.MemPos<ComFileOffset then
  3049. begin
  3050. ObjSec.Data.seek(ComFileOffset-ObjSec.MemPos);
  3051. repeat
  3052. bytesread:=ObjSec.Data.read(buf,sizeof(buf));
  3053. if bytesread<>0 then
  3054. FWriter.write(buf,bytesread);
  3055. until bytesread=0;
  3056. end
  3057. else
  3058. FWriter.writearray(ObjSec.Data);
  3059. end;
  3060. end;
  3061. end;
  3062. Result:=True;
  3063. end;
  3064. function TMZExeOutput.writeDebugElf: boolean;
  3065. label
  3066. cleanup;
  3067. var
  3068. debugsections: array of TMZExeSection;
  3069. debugsections_count: Word;
  3070. elfsections_count: Word;
  3071. elfsechdrs: array of TElf32sechdr;
  3072. shstrndx: Word;
  3073. next_section_ofs, elf_start_pos, elf_end_pos: LongWord;
  3074. ElfHeader: TElf32header;
  3075. shstrtabsect_data: TDynamicArray=Nil;
  3076. I, elfsecidx, J: Integer;
  3077. ObjSec: TOmfObjSection;
  3078. tis_trailer: TTISTrailer;
  3079. begin
  3080. debugsections:=nil;
  3081. elfsechdrs:=nil;
  3082. { mark the offset of the start of the ELF image }
  3083. elf_start_pos:=Writer.Size;
  3084. { count the debug sections }
  3085. debugsections_count:=0;
  3086. for I:=0 to ExeSectionList.Count-1 do
  3087. if oso_debug in TMZExeSection(ExeSectionList[I]).SecOptions then
  3088. Inc(debugsections_count);
  3089. { extract them into the debugsections array }
  3090. SetLength(debugsections,debugsections_count);
  3091. debugsections_count:=0;
  3092. for I:=0 to ExeSectionList.Count-1 do
  3093. if oso_debug in TMZExeSection(ExeSectionList[I]).SecOptions then
  3094. begin
  3095. debugsections[debugsections_count]:=TMZExeSection(ExeSectionList[I]);
  3096. Inc(debugsections_count);
  3097. end;
  3098. { prepare/allocate elf section headers }
  3099. elfsections_count:=debugsections_count+2;
  3100. SetLength(elfsechdrs,elfsections_count);
  3101. for I:=0 to elfsections_count-1 do
  3102. FillChar(elfsechdrs[I],SizeOf(elfsechdrs[I]),0);
  3103. shstrndx:=elfsections_count-1;
  3104. shstrtabsect_data:=tdynamicarray.Create(SectionDataMaxGrow);
  3105. shstrtabsect_data.writestr(#0);
  3106. next_section_ofs:=SizeOf(ElfHeader)+elfsections_count*SizeOf(TElf32sechdr);
  3107. for I:=0 to debugsections_count-1 do
  3108. begin
  3109. elfsecidx:=I+1;
  3110. with elfsechdrs[elfsecidx] do
  3111. begin
  3112. sh_name:=shstrtabsect_data.Pos;
  3113. sh_type:=SHT_PROGBITS;
  3114. sh_flags:=0;
  3115. sh_addr:=0;
  3116. sh_offset:=next_section_ofs;
  3117. sh_size:=debugsections[I].Size;
  3118. sh_link:=0;
  3119. sh_info:=0;
  3120. sh_addralign:=0;
  3121. sh_entsize:=0;
  3122. end;
  3123. Inc(next_section_ofs,debugsections[I].Size);
  3124. shstrtabsect_data.writestr(debugsections[I].Name+#0);
  3125. end;
  3126. with elfsechdrs[shstrndx] do
  3127. begin
  3128. sh_name:=shstrtabsect_data.Pos;
  3129. shstrtabsect_data.writestr('.shstrtab'#0);
  3130. sh_type:=SHT_STRTAB;
  3131. sh_flags:=0;
  3132. sh_addr:=0;
  3133. sh_offset:=next_section_ofs;
  3134. sh_size:=shstrtabsect_data.Size;
  3135. sh_link:=0;
  3136. sh_info:=0;
  3137. sh_addralign:=0;
  3138. sh_entsize:=0;
  3139. end;
  3140. { write header }
  3141. FillChar(ElfHeader,SizeOf(ElfHeader),0);
  3142. ElfHeader.e_ident[EI_MAG0]:=ELFMAG0; { = #127'ELF' }
  3143. ElfHeader.e_ident[EI_MAG1]:=ELFMAG1;
  3144. ElfHeader.e_ident[EI_MAG2]:=ELFMAG2;
  3145. ElfHeader.e_ident[EI_MAG3]:=ELFMAG3;
  3146. ElfHeader.e_ident[EI_CLASS]:=ELFCLASS32;
  3147. ElfHeader.e_ident[EI_DATA]:=ELFDATA2LSB;
  3148. ElfHeader.e_ident[EI_VERSION]:=1;
  3149. ElfHeader.e_ident[EI_OSABI]:=ELFOSABI_NONE;
  3150. ElfHeader.e_ident[EI_ABIVERSION]:=0;
  3151. ElfHeader.e_type:=ET_EXEC;
  3152. ElfHeader.e_machine:=EM_386;
  3153. ElfHeader.e_version:=1;
  3154. ElfHeader.e_entry:=0;
  3155. ElfHeader.e_phoff:=0;
  3156. ElfHeader.e_shoff:=SizeOf(ElfHeader);
  3157. ElfHeader.e_flags:=0;
  3158. ElfHeader.e_ehsize:=SizeOf(ElfHeader);
  3159. ElfHeader.e_phentsize:=SizeOf(TElf32proghdr);
  3160. ElfHeader.e_phnum:=0;
  3161. ElfHeader.e_shentsize:=SizeOf(TElf32sechdr);
  3162. ElfHeader.e_shnum:=elfsections_count;
  3163. ElfHeader.e_shstrndx:=shstrndx;
  3164. MaybeSwapHeader(ElfHeader);
  3165. Writer.write(ElfHeader,sizeof(ElfHeader));
  3166. { write section headers }
  3167. for I:=0 to elfsections_count-1 do
  3168. begin
  3169. MaybeSwapSecHeader(elfsechdrs[I]);
  3170. Writer.write(elfsechdrs[I],SizeOf(elfsechdrs[I]));
  3171. end;
  3172. { write section data }
  3173. for J:=0 to debugsections_count-1 do
  3174. begin
  3175. debugsections[J].DataPos:=Writer.Size;
  3176. for i:=0 to debugsections[J].ObjSectionList.Count-1 do
  3177. begin
  3178. ObjSec:=TOmfObjSection(debugsections[J].ObjSectionList[i]);
  3179. if assigned(ObjSec.Data) then
  3180. FWriter.writearray(ObjSec.Data);
  3181. end;
  3182. end;
  3183. { write .shstrtab section data }
  3184. Writer.writearray(shstrtabsect_data);
  3185. { mark the offset past the end of the ELF image }
  3186. elf_end_pos:=Writer.Size;
  3187. { write TIS trailer (not part of the ELF image) }
  3188. FillChar(tis_trailer,sizeof(tis_trailer),0);
  3189. with tis_trailer do
  3190. begin
  3191. tis_signature:=TIS_TRAILER_SIGNATURE;
  3192. tis_vendor:=TIS_TRAILER_VENDOR_TIS;
  3193. tis_type:=TIS_TRAILER_TYPE_TIS_DWARF;
  3194. tis_size:=(elf_end_pos-elf_start_pos)+sizeof(tis_trailer);
  3195. end;
  3196. MayBeSwapTISTrailer(tis_trailer);
  3197. Writer.write(tis_trailer,sizeof(tis_trailer));
  3198. Result:=True;
  3199. cleanup:
  3200. shstrtabsect_data.Free;
  3201. end;
  3202. procedure TMZExeOutput.Load_Symbol(const aname: string);
  3203. var
  3204. dgroup: TObjSectionGroup;
  3205. sym: TObjSymbol;
  3206. begin
  3207. { special handling for the '_edata' and '_end' symbols, which are
  3208. internally added by the linker }
  3209. if (aname='_edata') or (aname='_end') then
  3210. begin
  3211. { create an internal segment with the 'BSS' class }
  3212. internalObjData.createsection('*'+aname+'||BSS',0,[]);
  3213. { add to group 'DGROUP' }
  3214. dgroup:=nil;
  3215. if assigned(internalObjData.GroupsList) then
  3216. dgroup:=TObjSectionGroup(internalObjData.GroupsList.Find('DGROUP'));
  3217. if dgroup=nil then
  3218. dgroup:=internalObjData.createsectiongroup('DGROUP');
  3219. SetLength(dgroup.members,Length(dgroup.members)+1);
  3220. dgroup.members[Length(dgroup.members)-1]:=internalObjData.CurrObjSec;
  3221. { define the symbol itself }
  3222. sym:=internalObjData.SymbolDefine(aname,AB_GLOBAL,AT_DATA);
  3223. sym.group:=dgroup;
  3224. end
  3225. else
  3226. inherited;
  3227. end;
  3228. procedure TMZExeOutput.DoRelocationFixup(objsec: TObjSection);
  3229. var
  3230. i: Integer;
  3231. omfsec: TOmfObjSection absolute objsec;
  3232. objreloc: TOmfRelocation;
  3233. target: DWord;
  3234. framebase: DWord;
  3235. fixupamount: Integer;
  3236. target_group: TMZExeUnifiedLogicalGroup;
  3237. procedure FixupOffset;
  3238. var
  3239. w: Word;
  3240. begin
  3241. omfsec.Data.seek(objreloc.DataOffset);
  3242. omfsec.Data.read(w,2);
  3243. w:=LEtoN(w);
  3244. Inc(w,fixupamount);
  3245. w:=LEtoN(w);
  3246. omfsec.Data.seek(objreloc.DataOffset);
  3247. omfsec.Data.write(w,2);
  3248. end;
  3249. procedure FixupOffset32;
  3250. var
  3251. lw: LongWord;
  3252. begin
  3253. omfsec.Data.seek(objreloc.DataOffset);
  3254. omfsec.Data.read(lw,4);
  3255. lw:=LEtoN(lw);
  3256. Inc(lw,fixupamount);
  3257. lw:=LEtoN(lw);
  3258. omfsec.Data.seek(objreloc.DataOffset);
  3259. omfsec.Data.write(lw,4);
  3260. end;
  3261. procedure FixupBase(DataOffset: LongWord);
  3262. var
  3263. w: Word;
  3264. begin
  3265. omfsec.Data.seek(DataOffset);
  3266. omfsec.Data.read(w,2);
  3267. w:=LEtoN(w);
  3268. Inc(w,framebase shr 4);
  3269. w:=LEtoN(w);
  3270. omfsec.Data.seek(DataOffset);
  3271. omfsec.Data.write(w,2);
  3272. Header.AddRelocation(omfsec.MZExeUnifiedLogicalSegment.MemBasePos shr 4,
  3273. omfsec.MemPos+DataOffset-omfsec.MZExeUnifiedLogicalSegment.MemBasePos);
  3274. end;
  3275. begin
  3276. for i:=0 to objsec.ObjRelocations.Count-1 do
  3277. begin
  3278. objreloc:=TOmfRelocation(objsec.ObjRelocations[i]);
  3279. if assigned(objreloc.symbol) then
  3280. begin
  3281. target:=objreloc.symbol.address;
  3282. if objreloc.FrameGroup<>'' then
  3283. framebase:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups.Find(objreloc.FrameGroup)).MemPos
  3284. else if assigned(objreloc.symbol.group) then
  3285. framebase:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups.Find(objreloc.symbol.group.Name)).MemPos
  3286. else
  3287. framebase:=TOmfObjSection(objreloc.symbol.objsection).MZExeUnifiedLogicalSegment.MemBasePos;
  3288. case objreloc.typ of
  3289. RELOC_ABSOLUTE16,RELOC_ABSOLUTE32,RELOC_SEG,RELOC_FARPTR,RELOC_FARPTR48:
  3290. fixupamount:=target-framebase;
  3291. RELOC_RELATIVE16,RELOC_SEGREL,RELOC_FARPTR_RELATIVEOFFSET:
  3292. fixupamount:=target-(omfsec.MemPos+objreloc.DataOffset)-2;
  3293. RELOC_RELATIVE32,RELOC_FARPTR48_RELATIVEOFFSET:
  3294. fixupamount:=target-(omfsec.MemPos+objreloc.DataOffset)-4;
  3295. else
  3296. internalerror(2015082402);
  3297. end;
  3298. case objreloc.typ of
  3299. RELOC_ABSOLUTE16,
  3300. RELOC_RELATIVE16:
  3301. FixupOffset;
  3302. RELOC_ABSOLUTE32,
  3303. RELOC_RELATIVE32:
  3304. FixupOffset32;
  3305. RELOC_SEG,
  3306. RELOC_SEGREL:
  3307. FixupBase(objreloc.DataOffset);
  3308. RELOC_FARPTR,
  3309. RELOC_FARPTR_RELATIVEOFFSET:
  3310. begin
  3311. FixupOffset;
  3312. FixupBase(objreloc.DataOffset+2);
  3313. end;
  3314. RELOC_FARPTR48,
  3315. RELOC_FARPTR48_RELATIVEOFFSET:
  3316. begin
  3317. FixupOffset32;
  3318. FixupBase(objreloc.DataOffset+4);
  3319. end;
  3320. else
  3321. internalerror(2015082403);
  3322. end;
  3323. end
  3324. else if assigned(objreloc.objsection) then
  3325. begin
  3326. target:=objreloc.objsection.MemPos;
  3327. if objreloc.FrameGroup<>'' then
  3328. framebase:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups.Find(objreloc.FrameGroup)).MemPos
  3329. else
  3330. begin
  3331. if assigned(TOmfObjSection(objreloc.objsection).MZExeUnifiedLogicalSegment) then
  3332. framebase:=TOmfObjSection(objreloc.objsection).MZExeUnifiedLogicalSegment.MemBasePos
  3333. else
  3334. begin
  3335. framebase:=0;
  3336. Comment(V_Warning,'Encountered an OMF reference to a section, that has been removed by smartlinking: '+TOmfObjSection(objreloc.objsection).Name);
  3337. end;
  3338. end;
  3339. case objreloc.typ of
  3340. RELOC_ABSOLUTE16,RELOC_ABSOLUTE32,RELOC_SEG,RELOC_FARPTR,RELOC_FARPTR48:
  3341. fixupamount:=target-framebase;
  3342. RELOC_RELATIVE16,RELOC_SEGREL,RELOC_FARPTR_RELATIVEOFFSET:
  3343. fixupamount:=target-(omfsec.MemPos+objreloc.DataOffset)-2;
  3344. RELOC_RELATIVE32,RELOC_FARPTR48_RELATIVEOFFSET:
  3345. fixupamount:=target-(omfsec.MemPos+objreloc.DataOffset)-4;
  3346. else
  3347. internalerror(2015082405);
  3348. end;
  3349. case objreloc.typ of
  3350. RELOC_ABSOLUTE16,
  3351. RELOC_RELATIVE16:
  3352. FixupOffset;
  3353. RELOC_ABSOLUTE32,
  3354. RELOC_RELATIVE32:
  3355. FixupOffset32;
  3356. RELOC_SEG,
  3357. RELOC_SEGREL:
  3358. FixupBase(objreloc.DataOffset);
  3359. RELOC_FARPTR,
  3360. RELOC_FARPTR_RELATIVEOFFSET:
  3361. begin
  3362. FixupOffset;
  3363. FixupBase(objreloc.DataOffset+2);
  3364. end;
  3365. RELOC_FARPTR48,
  3366. RELOC_FARPTR48_RELATIVEOFFSET:
  3367. begin
  3368. FixupOffset32;
  3369. FixupBase(objreloc.DataOffset+4);
  3370. end;
  3371. else
  3372. internalerror(2015082406);
  3373. end;
  3374. end
  3375. else if assigned(objreloc.group) then
  3376. begin
  3377. target_group:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups.Find(objreloc.group.Name));
  3378. target:=target_group.MemPos;
  3379. if objreloc.FrameGroup<>'' then
  3380. framebase:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups.Find(objreloc.FrameGroup)).MemPos
  3381. else
  3382. framebase:=target_group.MemPos;
  3383. case objreloc.typ of
  3384. RELOC_ABSOLUTE16,RELOC_ABSOLUTE32,RELOC_SEG,RELOC_FARPTR,RELOC_FARPTR48:
  3385. fixupamount:=target-framebase;
  3386. RELOC_RELATIVE16,RELOC_SEGREL,RELOC_FARPTR_RELATIVEOFFSET:
  3387. fixupamount:=target-(omfsec.MemPos+objreloc.DataOffset)-2;
  3388. RELOC_RELATIVE32,RELOC_FARPTR48_RELATIVEOFFSET:
  3389. fixupamount:=target-(omfsec.MemPos+objreloc.DataOffset)-4;
  3390. else
  3391. internalerror(2015111202);
  3392. end;
  3393. case objreloc.typ of
  3394. RELOC_ABSOLUTE16,
  3395. RELOC_RELATIVE16:
  3396. FixupOffset;
  3397. RELOC_ABSOLUTE32,
  3398. RELOC_RELATIVE32:
  3399. FixupOffset32;
  3400. RELOC_SEG,
  3401. RELOC_SEGREL:
  3402. FixupBase(objreloc.DataOffset);
  3403. RELOC_FARPTR,
  3404. RELOC_FARPTR_RELATIVEOFFSET:
  3405. begin
  3406. FixupOffset;
  3407. FixupBase(objreloc.DataOffset+2);
  3408. end;
  3409. RELOC_FARPTR48,
  3410. RELOC_FARPTR48_RELATIVEOFFSET:
  3411. begin
  3412. FixupOffset32;
  3413. FixupBase(objreloc.DataOffset+4);
  3414. end;
  3415. else
  3416. internalerror(2015111203);
  3417. end;
  3418. end
  3419. else
  3420. internalerror(2015082407);
  3421. end;
  3422. end;
  3423. function IOmfObjSectionClassNameCompare(Item1, Item2: Pointer): Integer;
  3424. var
  3425. I1 : TOmfObjSection absolute Item1;
  3426. I2 : TOmfObjSection absolute Item2;
  3427. begin
  3428. Result:=CompareStr(I1.ClassName,I2.ClassName);
  3429. if Result=0 then
  3430. Result:=CompareStr(I1.Name,I2.Name);
  3431. if Result=0 then
  3432. Result:=I1.SortOrder-I2.SortOrder;
  3433. end;
  3434. procedure TMZExeOutput.Order_ObjSectionList(ObjSectionList: TFPObjectList; const aPattern: string);
  3435. var
  3436. i: Integer;
  3437. begin
  3438. for i:=0 to ObjSectionList.Count-1 do
  3439. TOmfObjSection(ObjSectionList[i]).SortOrder:=i;
  3440. ObjSectionList.Sort(@IOmfObjSectionClassNameCompare);
  3441. end;
  3442. procedure TMZExeOutput.MemPos_ExeSection(const aname: string);
  3443. begin
  3444. { overlay all .exe sections on top of each other. In practice, the MZ
  3445. formats doesn't have sections, so really, everything goes to a single
  3446. section, called .MZ_flat_content. All the remaining sections, that we
  3447. use are the debug sections, which go to a separate ELF file, appended
  3448. after the end of the .exe. They live in a separate address space, with
  3449. each section starting at virtual offset 0. So, that's why we always
  3450. set CurrMemPos to 0 before each section here. }
  3451. CurrMemPos:=0;
  3452. inherited MemPos_ExeSection(aname);
  3453. end;
  3454. procedure TMZExeOutput.MemPos_EndExeSection;
  3455. var
  3456. SecName: TSymStr='';
  3457. begin
  3458. if assigned(CurrExeSec) then
  3459. SecName:=CurrExeSec.Name;
  3460. inherited MemPos_EndExeSection;
  3461. case SecName of
  3462. '.MZ_flat_content':
  3463. begin
  3464. CalcExeUnifiedLogicalSegments;
  3465. CalcExeGroups;
  3466. CalcSegments_MemBasePos;
  3467. if assigned(exemap) then
  3468. WriteMap_SegmentsAndGroups;
  3469. end;
  3470. '.debug_info',
  3471. '.debug_abbrev',
  3472. '.debug_line',
  3473. '.debug_aranges':
  3474. begin
  3475. CalcDwarfUnifiedLogicalSegmentsForSection(SecName);
  3476. with TMZExeSection(FindExeSection(SecName)) do
  3477. SecOptions:=SecOptions+[oso_debug];
  3478. end;
  3479. '':
  3480. {nothing to do};
  3481. else
  3482. internalerror(2018061401);
  3483. end;
  3484. end;
  3485. function TMZExeOutput.writeData: boolean;
  3486. begin
  3487. Result:=False;
  3488. if ExeWriteMode in [ewm_exefull,ewm_exeonly] then
  3489. begin
  3490. if apptype=app_com then
  3491. Result:=WriteCom
  3492. else
  3493. Result:=WriteExe;
  3494. if not Result then
  3495. exit;
  3496. end;
  3497. if ((cs_debuginfo in current_settings.moduleswitches) and
  3498. (target_dbg.id in [dbg_dwarf2,dbg_dwarf3,dbg_dwarf4])) and
  3499. ((ExeWriteMode=ewm_dbgonly) or
  3500. ((ExeWriteMode=ewm_exefull) and
  3501. not(cs_link_strip in current_settings.globalswitches))) then
  3502. Result:=writeDebugElf;
  3503. end;
  3504. constructor TMZExeOutput.create;
  3505. begin
  3506. inherited create;
  3507. CExeSection:=TMZExeSection;
  3508. CObjData:=TOmfObjData;
  3509. CObjSymbol:=TOmfObjSymbol;
  3510. { "640K ought to be enough for anybody" :) }
  3511. MaxMemPos:=$9FFFF;
  3512. FExeUnifiedLogicalSegments:=TFPHashObjectList.Create;
  3513. FExeUnifiedLogicalGroups:=TFPHashObjectList.Create;
  3514. FDwarfUnifiedLogicalSegments:=TFPHashObjectList.Create;
  3515. FHeader:=TMZExeHeader.Create;
  3516. end;
  3517. destructor TMZExeOutput.destroy;
  3518. begin
  3519. FHeader.Free;
  3520. FDwarfUnifiedLogicalSegments.Free;
  3521. FExeUnifiedLogicalGroups.Free;
  3522. FExeUnifiedLogicalSegments.Free;
  3523. inherited destroy;
  3524. end;
  3525. {****************************************************************************
  3526. TNewExeHeader
  3527. ****************************************************************************}
  3528. constructor TNewExeHeader.Create;
  3529. begin
  3530. SetLength(FMsDosStub,High(win16stub)-Low(win16stub)+1);
  3531. Move(win16stub[Low(win16stub)],FMsDosStub[0],High(win16stub)-Low(win16stub)+1);
  3532. { BP7 identifies itself as linker version 6.1 in the Win16 .exe files it produces }
  3533. LinkerVersion:=6;
  3534. LinkerRevision:=1;
  3535. LogicalSectorAlignmentShiftCount:=8; { 256-byte logical sectors }
  3536. TargetOS:=netoWindows;
  3537. ExpectedWindowsVersion:=$0300;
  3538. Flags:=[nehfNotWindowAPICompatible,nehfWindowAPICompatible,nehfMultipleData,nehfProtectedModeOnly];
  3539. AdditionalFlags:=[];
  3540. GangLoadAreaStart:=0;
  3541. GangLoadAreaLength:=0;
  3542. Reserved:=0;
  3543. Reserved2:=0;
  3544. end;
  3545. procedure TNewExeHeader.WriteTo(aWriter: TObjectWriter);
  3546. var
  3547. HeaderBytes: array [0..$3F] of Byte;
  3548. begin
  3549. aWriter.write(MsDosStub[0],Length(MsDosStub));
  3550. HeaderBytes[$00]:=$4E; { 'N' }
  3551. HeaderBytes[$01]:=$45; { 'E' }
  3552. HeaderBytes[$02]:=Byte(LinkerVersion);
  3553. HeaderBytes[$03]:=Byte(LinkerRevision);
  3554. HeaderBytes[$04]:=Byte(EntryTableOffset);
  3555. HeaderBytes[$05]:=Byte(EntryTableOffset shr 8);
  3556. HeaderBytes[$06]:=Byte(EntryTableLength);
  3557. HeaderBytes[$07]:=Byte(EntryTableLength shr 8);
  3558. HeaderBytes[$08]:=Byte(Reserved);
  3559. HeaderBytes[$09]:=Byte(Reserved shr 8);
  3560. HeaderBytes[$0A]:=Byte(Reserved shr 16);
  3561. HeaderBytes[$0B]:=Byte(Reserved shr 24);
  3562. HeaderBytes[$0C]:=Byte(Word(Flags));
  3563. HeaderBytes[$0D]:=Byte(Word(Flags) shr 8);
  3564. HeaderBytes[$0E]:=Byte(AutoDataSegmentNumber);
  3565. HeaderBytes[$0F]:=Byte(AutoDataSegmentNumber shr 8);
  3566. HeaderBytes[$10]:=Byte(InitialLocalHeapSize);
  3567. HeaderBytes[$11]:=Byte(InitialLocalHeapSize shr 8);
  3568. HeaderBytes[$12]:=Byte(InitialStackSize);
  3569. HeaderBytes[$13]:=Byte(InitialStackSize shr 8);
  3570. HeaderBytes[$14]:=Byte(InitialIP);
  3571. HeaderBytes[$15]:=Byte(InitialIP shr 8);
  3572. HeaderBytes[$16]:=Byte(InitialCS);
  3573. HeaderBytes[$17]:=Byte(InitialCS shr 8);
  3574. HeaderBytes[$18]:=Byte(InitialSP);
  3575. HeaderBytes[$19]:=Byte(InitialSP shr 8);
  3576. HeaderBytes[$1A]:=Byte(InitialSS);
  3577. HeaderBytes[$1B]:=Byte(InitialSS shr 8);
  3578. HeaderBytes[$1C]:=Byte(SegmentTableEntriesCount);
  3579. HeaderBytes[$1D]:=Byte(SegmentTableEntriesCount shr 8);
  3580. HeaderBytes[$1E]:=Byte(ModuleReferenceTableEntriesCount);
  3581. HeaderBytes[$1F]:=Byte(ModuleReferenceTableEntriesCount shr 8);
  3582. HeaderBytes[$20]:=Byte(NonresidentNameTableLength);
  3583. HeaderBytes[$21]:=Byte(NonresidentNameTableLength shr 8);
  3584. HeaderBytes[$22]:=Byte(SegmentTableStart);
  3585. HeaderBytes[$23]:=Byte(SegmentTableStart shr 8);
  3586. HeaderBytes[$24]:=Byte(ResourceTableStart);
  3587. HeaderBytes[$25]:=Byte(ResourceTableStart shr 8);
  3588. HeaderBytes[$26]:=Byte(ResidentNameTableStart);
  3589. HeaderBytes[$27]:=Byte(ResidentNameTableStart shr 8);
  3590. HeaderBytes[$28]:=Byte(ModuleReferenceTableStart);
  3591. HeaderBytes[$29]:=Byte(ModuleReferenceTableStart shr 8);
  3592. HeaderBytes[$2A]:=Byte(ImportedNameTableStart);
  3593. HeaderBytes[$2B]:=Byte(ImportedNameTableStart shr 8);
  3594. HeaderBytes[$2C]:=Byte(NonresidentNameTableStart);
  3595. HeaderBytes[$2D]:=Byte(NonresidentNameTableStart shr 8);
  3596. HeaderBytes[$2E]:=Byte(NonresidentNameTableStart shr 16);
  3597. HeaderBytes[$2F]:=Byte(NonresidentNameTableStart shr 24);
  3598. HeaderBytes[$30]:=Byte(MovableEntryPointsCount);
  3599. HeaderBytes[$31]:=Byte(MovableEntryPointsCount shr 8);
  3600. HeaderBytes[$32]:=Byte(LogicalSectorAlignmentShiftCount);
  3601. HeaderBytes[$33]:=Byte(LogicalSectorAlignmentShiftCount shr 8);
  3602. HeaderBytes[$34]:=Byte(ResourceSegmentsCount);
  3603. HeaderBytes[$35]:=Byte(ResourceSegmentsCount shr 8);
  3604. HeaderBytes[$36]:=Byte(Ord(TargetOS));
  3605. HeaderBytes[$37]:=Byte(AdditionalFlags);
  3606. HeaderBytes[$38]:=Byte(GangLoadAreaStart);
  3607. HeaderBytes[$39]:=Byte(GangLoadAreaStart shr 8);
  3608. HeaderBytes[$3A]:=Byte(GangLoadAreaLength);
  3609. HeaderBytes[$3B]:=Byte(GangLoadAreaLength shr 8);
  3610. HeaderBytes[$3C]:=Byte(Reserved2);
  3611. HeaderBytes[$3D]:=Byte(Reserved2 shr 8);
  3612. HeaderBytes[$3E]:=Byte(ExpectedWindowsVersion);
  3613. HeaderBytes[$3F]:=Byte(ExpectedWindowsVersion shr 8);
  3614. aWriter.write(HeaderBytes[0],$40);
  3615. end;
  3616. {****************************************************************************
  3617. TNewExeResourceTable
  3618. ****************************************************************************}
  3619. function TNewExeResourceTable.GetSize: QWord;
  3620. begin
  3621. Result:=5;
  3622. end;
  3623. constructor TNewExeResourceTable.Create;
  3624. begin
  3625. ResourceDataAlignmentShiftCount:=8;
  3626. end;
  3627. procedure TNewExeResourceTable.WriteTo(aWriter: TObjectWriter);
  3628. procedure WriteAlignShift;
  3629. var
  3630. AlignShiftBytes: array [0..1] of Byte;
  3631. begin
  3632. AlignShiftBytes[0]:=Byte(ResourceDataAlignmentShiftCount);
  3633. AlignShiftBytes[1]:=Byte(ResourceDataAlignmentShiftCount shr 8);
  3634. aWriter.write(AlignShiftBytes[0],2);
  3635. end;
  3636. procedure WriteEndTypes;
  3637. const
  3638. EndTypesBytes: array [0..1] of Byte = (0, 0);
  3639. begin
  3640. aWriter.write(EndTypesBytes[0],2);
  3641. end;
  3642. procedure WriteEndNames;
  3643. const
  3644. EndNames: Byte = 0;
  3645. begin
  3646. aWriter.write(EndNames,1);
  3647. end;
  3648. begin
  3649. WriteAlignShift;
  3650. WriteEndTypes;
  3651. WriteEndNames;
  3652. end;
  3653. {****************************************************************************
  3654. TNewExeExportNameTableEntry
  3655. ****************************************************************************}
  3656. constructor TNewExeExportNameTableEntry.Create(HashObjectList:TFPHashObjectList;const s:TSymStr;OrdNr:Word);
  3657. begin
  3658. inherited Create(HashObjectList,s);
  3659. OrdinalNr:=OrdNr;
  3660. end;
  3661. {****************************************************************************
  3662. TNewExeExportNameTable
  3663. ****************************************************************************}
  3664. function TNewExeExportNameTable.GetSize: QWord;
  3665. var
  3666. i: Integer;
  3667. begin
  3668. { the end of table mark is 1 byte }
  3669. Result:=1;
  3670. { each entry is 3 bytes, plus the length of the name }
  3671. for i:=0 to Count-1 do
  3672. Inc(Result,3+Length(TNewExeExportNameTableEntry(Items[i]).Name));
  3673. end;
  3674. procedure TNewExeExportNameTable.WriteTo(aWriter: TObjectWriter);
  3675. var
  3676. i: Integer;
  3677. rn: TNewExeExportNameTableEntry;
  3678. slen: Byte;
  3679. OrdNrBuf: array [0..1] of Byte;
  3680. begin
  3681. for i:=0 to Count-1 do
  3682. begin
  3683. rn:=TNewExeExportNameTableEntry(Items[i]);
  3684. slen:=Length(rn.Name);
  3685. if slen=0 then
  3686. internalerror(2019080801);
  3687. aWriter.write(slen,1);
  3688. aWriter.write(rn.Name[1],slen);
  3689. OrdNrBuf[0]:=Byte(rn.OrdinalNr);
  3690. OrdNrBuf[1]:=Byte(rn.OrdinalNr shr 8);
  3691. aWriter.write(OrdNrBuf[0],2);
  3692. end;
  3693. { end of table mark }
  3694. slen:=0;
  3695. aWriter.write(slen,1);
  3696. end;
  3697. {****************************************************************************
  3698. TNewExeModuleReferenceTable
  3699. ****************************************************************************}
  3700. function TNewExeModuleReferenceTable.GetSize: QWord;
  3701. begin
  3702. Result:=Count*2;
  3703. end;
  3704. procedure TNewExeModuleReferenceTable.AddModuleReference(const dllname:TSymStr);
  3705. begin
  3706. if not Assigned(Find(dllname)) then
  3707. TNewExeModuleReferenceTableEntry.Create(Self,dllname);
  3708. end;
  3709. procedure TNewExeModuleReferenceTable.WriteTo(aWriter: TObjectWriter;imptbl: TNewExeImportedNameTable);
  3710. var
  3711. buf: array of Byte;
  3712. i: Integer;
  3713. ImpTblEntry: TNewExeImportedNameTableEntry;
  3714. begin
  3715. SetLength(buf,Size);
  3716. for i:=0 to Count-1 do
  3717. begin
  3718. ImpTblEntry:=TNewExeImportedNameTableEntry(imptbl.Find(TNewExeModuleReferenceTableEntry(Items[i]).Name));
  3719. if not Assigned(ImpTblEntry) then
  3720. internalerror(2019080903);
  3721. buf[2*i]:=Byte(ImpTblEntry.TableOffset);
  3722. buf[2*i+1]:=Byte(ImpTblEntry.TableOffset shr 8);
  3723. end;
  3724. aWriter.write(buf[0],Length(buf));
  3725. end;
  3726. {****************************************************************************
  3727. TNewExeImportedNameTable
  3728. ****************************************************************************}
  3729. function TNewExeImportedNameTable.GetSize: QWord;
  3730. var
  3731. i: Integer;
  3732. begin
  3733. { the table starts with an empty entry, which takes 1 byte }
  3734. Result:=1;
  3735. { each entry is 1 byte, plus the length of the name }
  3736. for i:=0 to Count-1 do
  3737. Inc(Result,1+Length(TNewExeImportedNameTableEntry(Items[i]).Name));
  3738. end;
  3739. procedure TNewExeImportedNameTable.AddImportedName(const name: TSymStr);
  3740. begin
  3741. if not Assigned(Find(name)) then
  3742. TNewExeImportedNameTableEntry.Create(Self,name);
  3743. end;
  3744. procedure TNewExeImportedNameTable.CalcTableOffsets;
  3745. var
  3746. cofs: LongInt;
  3747. i: Integer;
  3748. entry: TNewExeImportedNameTableEntry;
  3749. begin
  3750. { the table starts with an empty entry, which takes 1 byte }
  3751. cofs:=1;
  3752. for i:=0 to Count-1 do
  3753. begin
  3754. entry:=TNewExeImportedNameTableEntry(Items[i]);
  3755. entry.TableOffset:=cofs;
  3756. Inc(cofs,1+Length(entry.Name));
  3757. if cofs>High(Word) then
  3758. internalerror(2019080902);
  3759. end;
  3760. end;
  3761. procedure TNewExeImportedNameTable.WriteTo(aWriter: TObjectWriter);
  3762. var
  3763. i: Integer;
  3764. entry: TNewExeImportedNameTableEntry;
  3765. slen: Byte;
  3766. begin
  3767. { the table starts with an empty entry }
  3768. slen:=0;
  3769. aWriter.write(slen,1);
  3770. for i:=0 to Count-1 do
  3771. begin
  3772. entry:=TNewExeImportedNameTableEntry(Items[i]);
  3773. slen:=Length(entry.Name);
  3774. if slen=0 then
  3775. internalerror(2019080901);
  3776. aWriter.write(slen,1);
  3777. aWriter.write(entry.Name[1],slen);
  3778. end;
  3779. end;
  3780. {****************************************************************************
  3781. TNewExeEntryPoint
  3782. ****************************************************************************}
  3783. function TNewExeEntryPoint.GetFlagsByte: Byte;
  3784. begin
  3785. Result:=Byte(ParmCount shl 3);
  3786. if neepfExported in Flags then
  3787. Result:=Result or 1;
  3788. if neepfSingleData in Flags then
  3789. Result:=Result or 2;
  3790. end;
  3791. {****************************************************************************
  3792. TNewExeEntryTable
  3793. ****************************************************************************}
  3794. function TNewExeEntryTable.GetSize: QWord;
  3795. var
  3796. CurBundleStart, i: Integer;
  3797. CurBundleSize: Byte;
  3798. cp: TNewExeEntryPoint;
  3799. begin
  3800. Result:=0;
  3801. CurBundleStart:=1;
  3802. repeat
  3803. CurBundleSize:=BundleSize(CurBundleStart);
  3804. Inc(Result,2);
  3805. if CurBundleSize>0 then
  3806. begin
  3807. if Items[CurBundleStart]=nil then
  3808. { a bundle of null entries }
  3809. else if neepfMovableSegment in Items[CurBundleStart].Flags then
  3810. { a bundle of movable segment records }
  3811. Inc(Result,6*CurBundleSize)
  3812. else
  3813. { a bundle of fixed segment records }
  3814. Inc(Result,3*CurBundleSize);
  3815. end;
  3816. Inc(CurBundleStart,CurBundleSize);
  3817. until CurBundleSize=0;
  3818. end;
  3819. procedure TNewExeEntryTable.SetItems(i: Integer; AValue: TNewExeEntryPoint);
  3820. begin
  3821. if (i<1) or (i>Length(FItems)) then
  3822. internalerror(2019081002);
  3823. FItems[i-1]:=AValue;
  3824. end;
  3825. function TNewExeEntryTable.CanBeInSameBundle(i, j: Integer): Boolean;
  3826. begin
  3827. if (Items[i]=nil) or (Items[j]=nil) then
  3828. Result:=(Items[i]=nil) and (Items[j]=nil)
  3829. else if not (neepfMovableSegment in Items[i].Flags) and
  3830. not (neepfMovableSegment in Items[j].Flags) then
  3831. Result:=Items[i].Segment=Items[j].Segment
  3832. else
  3833. Result:=(neepfMovableSegment in Items[i].Flags)=
  3834. (neepfMovableSegment in Items[j].Flags);
  3835. end;
  3836. function TNewExeEntryTable.BundleSize(StartingElement:Integer): Byte;
  3837. begin
  3838. if StartingElement>Count then
  3839. Result:=0
  3840. else
  3841. begin
  3842. Result:=1;
  3843. while (Result<255) and ((StartingElement+Result)<=Count) and CanBeInSameBundle(StartingElement,StartingElement+Result) do
  3844. Inc(Result);
  3845. end;
  3846. end;
  3847. function TNewExeEntryTable.GetCount: Word;
  3848. begin
  3849. Result:=Length(FItems);
  3850. end;
  3851. function TNewExeEntryTable.GetItems(i: Integer): TNewExeEntryPoint;
  3852. begin
  3853. if (i<1) or (i>Length(FItems)) then
  3854. internalerror(2019081002);
  3855. Result:=FItems[i-1];
  3856. end;
  3857. destructor TNewExeEntryTable.Destroy;
  3858. var
  3859. i: Integer;
  3860. begin
  3861. for i:=low(FItems) to high(FItems) do
  3862. FreeAndNil(FItems[i]);
  3863. inherited Destroy;
  3864. end;
  3865. procedure TNewExeEntryTable.WriteTo(aWriter: TObjectWriter);
  3866. var
  3867. CurBundleStart, i: Integer;
  3868. CurBundleSize: Byte;
  3869. buf: array [0..5] of Byte;
  3870. cp: TNewExeEntryPoint;
  3871. begin
  3872. CurBundleStart:=1;
  3873. repeat
  3874. CurBundleSize:=BundleSize(CurBundleStart);
  3875. aWriter.write(CurBundleSize,1);
  3876. if CurBundleSize>0 then
  3877. begin
  3878. if Items[CurBundleStart]=nil then
  3879. begin
  3880. { a bundle of null entries }
  3881. buf[0]:=0;
  3882. aWriter.write(buf[0],1);
  3883. end
  3884. else if neepfMovableSegment in Items[CurBundleStart].Flags then
  3885. begin
  3886. { a bundle of movable segment records }
  3887. buf[0]:=$ff;
  3888. aWriter.write(buf[0],1);
  3889. for i:=CurBundleStart to CurBundleStart+CurBundleSize-1 do
  3890. begin
  3891. cp:=Items[i];
  3892. buf[0]:=cp.FlagsByte;
  3893. buf[1]:=$CD; { INT 3Fh instruction }
  3894. buf[2]:=$3F;
  3895. buf[3]:=Byte(cp.Segment);
  3896. buf[4]:=Byte(cp.Offset);
  3897. buf[5]:=Byte(cp.Offset shr 8);
  3898. aWriter.write(buf[0],6);
  3899. end;
  3900. end
  3901. else
  3902. begin
  3903. { a bundle of fixed segment records }
  3904. buf[0]:=Items[CurBundleStart].Segment;
  3905. aWriter.write(buf[0],1);
  3906. for i:=CurBundleStart to CurBundleStart+CurBundleSize-1 do
  3907. begin
  3908. cp:=Items[i];
  3909. buf[0]:=cp.FlagsByte;
  3910. buf[1]:=Byte(cp.Offset);
  3911. buf[2]:=Byte(cp.Offset shr 8);
  3912. aWriter.write(buf[0],3);
  3913. end;
  3914. end;
  3915. end;
  3916. Inc(CurBundleStart,CurBundleSize);
  3917. until CurBundleSize=0;
  3918. { finish the end marker - a null bundle of 0 entries - must be 2 zero
  3919. bytes. The first one was already written by the loop, time to add the
  3920. second one. }
  3921. buf[0]:=0;
  3922. aWriter.write(buf[0],1);
  3923. end;
  3924. procedure TNewExeEntryTable.GrowTo(aNewCount: Word);
  3925. begin
  3926. if aNewCount<Count then
  3927. internalerror(2019081003);
  3928. SetLength(FItems,aNewCount);
  3929. end;
  3930. {****************************************************************************
  3931. TNewExeRelocation
  3932. ****************************************************************************}
  3933. procedure TNewExeRelocation.EncodeTo(dest: PByte);
  3934. begin
  3935. dest[0]:=Ord(AddressType);
  3936. dest[1]:=Ord(RelocationType) or (Ord(IsAdditive) shl 2);
  3937. dest[2]:=Byte(Offset);
  3938. dest[3]:=Byte(Offset shr 8);
  3939. case RelocationType of
  3940. nertInternalRef:
  3941. begin
  3942. case InternalRefSegmentType of
  3943. neirstFixed:
  3944. begin
  3945. dest[4]:=Byte(InternalRefFixedSegmentNumber);
  3946. dest[5]:=0;
  3947. dest[6]:=Byte(InternalRefFixedSegmentOffset);
  3948. dest[7]:=Byte(InternalRefFixedSegmentOffset shr 8);
  3949. end;
  3950. neirstMovable:
  3951. begin
  3952. dest[4]:=$FF;
  3953. dest[5]:=0;
  3954. dest[6]:=Byte(InternalRefMovableSegmentEntryTableIndex);
  3955. dest[7]:=Byte(InternalRefMovableSegmentEntryTableIndex shr 8);
  3956. end;
  3957. end;
  3958. end;
  3959. nertImportName:
  3960. begin
  3961. dest[4]:=Byte(ImportModuleIndex);
  3962. dest[5]:=Byte(ImportModuleIndex shr 8);
  3963. dest[6]:=Byte(ImportNameIndex);
  3964. dest[7]:=Byte(ImportNameIndex shr 8);
  3965. end;
  3966. nertImportOrdinal:
  3967. begin
  3968. dest[4]:=Byte(ImportModuleIndex);
  3969. dest[5]:=Byte(ImportModuleIndex shr 8);
  3970. dest[6]:=Byte(ImportOrdinal);
  3971. dest[7]:=Byte(ImportOrdinal shr 8);
  3972. end;
  3973. nertOsFixup:
  3974. begin
  3975. dest[4]:=Byte(Ord(OsFixupType));
  3976. dest[5]:=Byte(Ord(OsFixupType) shr 8);
  3977. dest[6]:=0;
  3978. dest[7]:=0;
  3979. end;
  3980. end;
  3981. end;
  3982. {****************************************************************************
  3983. TNewExeRelocationList
  3984. ****************************************************************************}
  3985. function TNewExeRelocationList.GetCount: Integer;
  3986. begin
  3987. Result:=FInternalList.Count;
  3988. end;
  3989. function TNewExeRelocationList.GetItem(Index: Integer): TNewExeRelocation;
  3990. begin
  3991. Result:=TNewExeRelocation(FInternalList[Index]);
  3992. end;
  3993. function TNewExeRelocationList.GetSize: QWord;
  3994. begin
  3995. Result:=2+Count*NewExeRelocationRecordSize;
  3996. end;
  3997. procedure TNewExeRelocationList.SetCount(AValue: Integer);
  3998. begin
  3999. FInternalList.Count:=AValue;
  4000. end;
  4001. procedure TNewExeRelocationList.SetItem(Index:Integer;AValue:TNewExeRelocation);
  4002. begin
  4003. FInternalList[Index]:=AValue;
  4004. end;
  4005. constructor TNewExeRelocationList.Create;
  4006. begin
  4007. FInternalList:=TFPObjectList.Create;
  4008. end;
  4009. destructor TNewExeRelocationList.Destroy;
  4010. begin
  4011. FInternalList.Free;
  4012. inherited Destroy;
  4013. end;
  4014. procedure TNewExeRelocationList.WriteTo(aWriter: TObjectWriter);
  4015. var
  4016. buf: array of Byte;
  4017. p: PByte;
  4018. i: Integer;
  4019. begin
  4020. SetLength(buf,Size);
  4021. buf[0]:=Byte(Count);
  4022. buf[1]:=Byte(Count shr 8);
  4023. p:=@(buf[2]);
  4024. for i:=0 to Count-1 do
  4025. begin
  4026. Items[i].EncodeTo(p);
  4027. Inc(p,NewExeRelocationRecordSize);
  4028. end;
  4029. aWriter.write(buf[0],Size);
  4030. end;
  4031. function TNewExeRelocationList.Add(AObject: TNewExeRelocation): Integer;
  4032. begin
  4033. Result:=FInternalList.Add(AObject);
  4034. end;
  4035. {****************************************************************************
  4036. TNewExeSection
  4037. ****************************************************************************}
  4038. function TNewExeSection.GetMinAllocSize: QWord;
  4039. begin
  4040. Result:=Size-StackSize;
  4041. end;
  4042. function TNewExeSection.GetNewExeSegmentFlags: TNewExeSegmentFlags;
  4043. begin
  4044. Result:=FNewExeSegmentFlags;
  4045. if Relocations.Count>0 then
  4046. Include(Result,nesfHasRelocationData)
  4047. else
  4048. Exclude(Result,nesfHasRelocationData);
  4049. end;
  4050. constructor TNewExeSection.create(AList:TFPHashObjectList;const AName:string);
  4051. begin
  4052. inherited create(AList, AName);
  4053. FRelocations:=TNewExeRelocationList.Create;
  4054. end;
  4055. destructor TNewExeSection.destroy;
  4056. begin
  4057. FRelocations.Free;
  4058. inherited destroy;
  4059. end;
  4060. procedure TNewExeSection.WriteHeaderTo(aWriter: TObjectWriter);
  4061. var
  4062. SegmentHeaderBytes: array [0..7] of Byte;
  4063. begin
  4064. SegmentHeaderBytes[0]:=Byte(DataPosSectors);
  4065. SegmentHeaderBytes[1]:=Byte(DataPosSectors shr 8);
  4066. SegmentHeaderBytes[2]:=Byte(SizeInFile);
  4067. SegmentHeaderBytes[3]:=Byte(SizeInFile shr 8);
  4068. SegmentHeaderBytes[4]:=Byte(Word(NewExeSegmentFlags));
  4069. SegmentHeaderBytes[5]:=Byte(Word(NewExeSegmentFlags) shr 8);
  4070. SegmentHeaderBytes[6]:=Byte(MinAllocSize);
  4071. SegmentHeaderBytes[7]:=Byte(MinAllocSize shr 8);
  4072. aWriter.write(SegmentHeaderBytes[0],8);
  4073. end;
  4074. function TNewExeSection.MemPosStr(AImageBase: qword): string;
  4075. begin
  4076. Result:=HexStr(MemBasePos,4)+':'+HexStr(MemPos,4);
  4077. end;
  4078. procedure TNewExeSection.AddObjSection(objsec: TObjSection; ignoreprops: boolean);
  4079. var
  4080. s: TSymStr;
  4081. Separator: SizeInt;
  4082. SegName, SegClass: string;
  4083. IsStack, IsBss: Boolean;
  4084. begin
  4085. { allow mixing initialized and uninitialized data in the same section
  4086. => set ignoreprops=true }
  4087. inherited AddObjSection(objsec,true);
  4088. IsBss:=not(oso_Data in objsec.SecOptions);
  4089. s:=objsec.Name;
  4090. { name format is 'SegName||ClassName' }
  4091. Separator:=Pos('||',s);
  4092. if Separator>0 then
  4093. begin
  4094. SegName:=Copy(s,1,Separator-1);
  4095. SegClass:=Copy(s,Separator+2,Length(s)-Separator-1);
  4096. end
  4097. else
  4098. begin
  4099. SegName:=s;
  4100. SegClass:='';
  4101. end;
  4102. { wlink recognizes the stack segment by the class name 'STACK' }
  4103. { let's be compatible with wlink }
  4104. IsStack:=SegClass='STACK';
  4105. { tlink (and ms link?) use the scStack segment combination to recognize
  4106. the stack segment.
  4107. let's be compatible with tlink as well }
  4108. if TOmfObjSection(ObjSec).Combination=scStack then
  4109. IsStack:=True;
  4110. if IsStack then
  4111. StackSize:=StackSize+objsec.Size;
  4112. EarlySize:=align_qword(EarlySize,SecAlign)+objsec.Size;
  4113. if (not IsBss) and (not IsStack) then
  4114. SizeInFile:=EarlySize;
  4115. end;
  4116. function TNewExeSection.CanAddObjSection(objsec: TObjSection; ExeSectionLimit: QWord): boolean;
  4117. var
  4118. NewSecAlign: LongInt;
  4119. NewSize: QWord;
  4120. begin
  4121. NewSecAlign:=max(objsec.SecAlign,SecAlign);
  4122. NewSize:=align_qword(EarlySize,NewSecAlign)+objsec.Size;
  4123. Result:=NewSize<=ExeSectionLimit;
  4124. end;
  4125. {****************************************************************************
  4126. TNewExeOutput
  4127. ****************************************************************************}
  4128. procedure TNewExeOutput.AddImportSymbol(const libname, symname,
  4129. symmangledname: TCmdStr; OrdNr: longint; isvar: boolean);
  4130. var
  4131. ImportLibrary: TImportLibrary;
  4132. ImportSymbol: TFPHashObject;
  4133. begin
  4134. ImportLibrary:=TImportLibrary(FImports.Find(libname));
  4135. if not assigned(ImportLibrary) then
  4136. ImportLibrary:=TImportLibrary.Create(FImports,libname);
  4137. ImportSymbol:=TFPHashObject(ImportLibrary.ImportSymbolList.Find(symname));
  4138. if not assigned(ImportSymbol) then
  4139. ImportSymbol:=TImportSymbol.Create(ImportLibrary.ImportSymbolList,symname,symmangledname,OrdNr,isvar);
  4140. end;
  4141. procedure TNewExeOutput.AddImportLibrariesExtractedFromObjectModules;
  4142. var
  4143. i, j, k: Integer;
  4144. ObjData: TOmfObjData;
  4145. ImportLibrary: TImportLibrary;
  4146. ImportSymbol: TImportSymbol;
  4147. begin
  4148. for i:=0 to ObjDataList.Count-1 do
  4149. begin
  4150. ObjData:=TOmfObjData(ObjDataList[i]);
  4151. for j:=0 to ObjData.ImportLibraryList.Count-1 do
  4152. begin
  4153. ImportLibrary:=TImportLibrary(ObjData.ImportLibraryList[j]);
  4154. for k:=0 to ImportLibrary.ImportSymbolList.Count-1 do
  4155. begin
  4156. ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[k]);
  4157. AddImportSymbol(ImportLibrary.Name,ImportSymbol.Name,ImportSymbol.MangledName,ImportSymbol.OrdNr,ImportSymbol.IsVar);
  4158. end;
  4159. end;
  4160. end;
  4161. end;
  4162. procedure TNewExeOutput.AddNewExeSection;
  4163. var
  4164. SegNr: Integer;
  4165. SecName: string;
  4166. begin
  4167. SegNr:=ExeSectionList.Count+1;
  4168. WriteStr(SecName,'Segment',SegNr,'_',NewExeMetaSection2String[CurrExeMetaSec]);
  4169. inherited Order_ExeSection(SecName);
  4170. TNewExeSection(CurrExeSec).ExeMetaSec:=CurrExeMetaSec;
  4171. TNewExeSection(CurrExeSec).MemBasePos:=SegNr;
  4172. if (CurrExeMetaSec=nemsData) and (Header.AutoDataSegmentNumber=0) then
  4173. Header.AutoDataSegmentNumber:=SegNr;
  4174. case CurrExeMetaSec of
  4175. nemsCode:
  4176. TNewExeSection(CurrExeSec).NewExeSegmentFlags:=[nesfMovable,nesfPreload];
  4177. nemsData:
  4178. TNewExeSection(CurrExeSec).NewExeSegmentFlags:=[nesfData,nesfPreload];
  4179. else
  4180. internalerror(2019070601);
  4181. end;
  4182. end;
  4183. function TNewExeOutput.WriteNewExe: boolean;
  4184. function ExtractModuleName(filename: string): string;
  4185. begin
  4186. Result:=UpCase(ChangeFileExt(filename,''));
  4187. end;
  4188. var
  4189. i: Integer;
  4190. begin
  4191. if IsSharedLibrary then
  4192. Header.Flags:=Header.Flags+[nehfIsDLL,nehfSingleData]-[nehfMultipleData];
  4193. { all exported symbols must have an ordinal }
  4194. AssignOrdinalsToAllExportSymbols;
  4195. AddEntryPointsForAllExportSymbols;
  4196. { the first entry in the resident-name table is the module name }
  4197. TNewExeExportNameTableEntry.Create(ResidentNameTable,ExtractModuleName(current_module.exefilename),0);
  4198. { the first entry in the nonresident-name table is the module description }
  4199. TNewExeExportNameTableEntry.Create(NonresidentNameTable,description,0);
  4200. { add all symbols, exported by name to the resident and nonresident-name tables }
  4201. AddExportedNames;
  4202. FillImportedNameAndModuleReferenceTable;
  4203. ImportedNameTable.CalcTableOffsets;
  4204. Header.InitialIP:=EntrySym.address;
  4205. Header.InitialCS:=TNewExeSection(EntrySym.objsection.ExeSection).MemBasePos;
  4206. Header.InitialSP:=0;
  4207. Header.InitialSS:=Header.AutoDataSegmentNumber;
  4208. Header.InitialStackSize:=TNewExeSection(ExeSectionList[Header.AutoDataSegmentNumber-1]).StackSize;
  4209. Header.InitialLocalHeapSize:=heapsize;
  4210. Header.SegmentTableStart:=NewExeHeaderSize;
  4211. Header.SegmentTableEntriesCount:=ExeSectionList.Count;
  4212. Header.ResourceTableStart:=Header.SegmentTableStart+NewExeSegmentHeaderSize*Header.SegmentTableEntriesCount;
  4213. Header.ResidentNameTableStart:=Header.ResourceTableStart+ResourceTable.Size;
  4214. Header.ModuleReferenceTableStart:=Header.ResidentNameTableStart+ResidentNameTable.Size;
  4215. Header.ModuleReferenceTableEntriesCount:=ModuleReferenceTable.Count;
  4216. Header.ImportedNameTableStart:=Header.ModuleReferenceTableStart+ModuleReferenceTable.Size;
  4217. Header.EntryTableOffset:=Header.ImportedNameTableStart+ImportedNameTable.Size;
  4218. Header.EntryTableLength:=EntryTable.Size;
  4219. Header.NonresidentNameTableStart:=Header.EntryTableOffset+Header.EntryTableLength+Length(Header.MsDosStub);
  4220. Header.NonresidentNameTableLength:=NonresidentNameTable.Size;
  4221. Header.WriteTo(FWriter);
  4222. for i:=0 to ExeSectionList.Count-1 do
  4223. TNewExeSection(ExeSectionList[i]).WriteHeaderTo(FWriter);
  4224. ResourceTable.WriteTo(FWriter);
  4225. ResidentNameTable.WriteTo(FWriter);
  4226. ModuleReferenceTable.WriteTo(FWriter,ImportedNameTable);
  4227. ImportedNameTable.WriteTo(FWriter);
  4228. EntryTable.WriteTo(FWriter);
  4229. NonresidentNameTable.WriteTo(FWriter);
  4230. { todo: write the rest of the file as well }
  4231. Result:=True;
  4232. end;
  4233. procedure TNewExeOutput.FillImportedNameAndModuleReferenceTable;
  4234. var
  4235. i, j: Integer;
  4236. ImportLibrary: TImportLibrary;
  4237. ImportSymbol: TImportSymbol;
  4238. exesym: TExeSymbol;
  4239. LibNameAdded: Boolean;
  4240. dllname: TSymStr;
  4241. begin
  4242. for i:=0 to FImports.Count-1 do
  4243. begin
  4244. ImportLibrary:=TImportLibrary(FImports[i]);
  4245. LibNameAdded:=False;
  4246. for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do
  4247. begin
  4248. ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
  4249. exesym:=TExeSymbol(ExeSymbolList.Find(ImportSymbol.MangledName));
  4250. if assigned(exesym) then
  4251. begin
  4252. if not LibNameAdded then
  4253. begin
  4254. dllname:=StripDllExt(ImportLibrary.Name);
  4255. ImportedNameTable.AddImportedName(dllname);
  4256. ModuleReferenceTable.AddModuleReference(dllname);
  4257. LibNameAdded:=True;
  4258. end;
  4259. if (ImportSymbol.OrdNr=0) and (ImportSymbol.Name<>'') then
  4260. ImportedNameTable.AddImportedName(ImportSymbol.Name);
  4261. end;
  4262. end;
  4263. end;
  4264. end;
  4265. function TNewExeOutput.GetHighestExportSymbolOrdinal: Word;
  4266. var
  4267. i, j: Integer;
  4268. ObjData: TOmfObjData;
  4269. sym: TOmfObjExportedSymbol;
  4270. begin
  4271. Result:=0;
  4272. for i:=0 to ObjDataList.Count-1 do
  4273. begin
  4274. ObjData:=TOmfObjData(ObjDataList[i]);
  4275. for j:=0 to ObjData.ExportedSymbolList.Count-1 do
  4276. begin
  4277. sym:=TOmfObjExportedSymbol(ObjData.ExportedSymbolList[j]);
  4278. if sym.ExportByOrdinal then
  4279. Result:=Max(Result,sym.ExportOrdinal);
  4280. end;
  4281. end;
  4282. end;
  4283. procedure TNewExeOutput.AssignOrdinalsToAllExportSymbols;
  4284. var
  4285. NextOrdinal: LongInt;
  4286. i, j: Integer;
  4287. ObjData: TOmfObjData;
  4288. sym: TOmfObjExportedSymbol;
  4289. begin
  4290. NextOrdinal:=GetHighestExportSymbolOrdinal+1;
  4291. for i:=0 to ObjDataList.Count-1 do
  4292. begin
  4293. ObjData:=TOmfObjData(ObjDataList[i]);
  4294. for j:=0 to ObjData.ExportedSymbolList.Count-1 do
  4295. begin
  4296. sym:=TOmfObjExportedSymbol(ObjData.ExportedSymbolList[j]);
  4297. if not sym.ExportByOrdinal then
  4298. begin
  4299. if NextOrdinal>High(Word) then
  4300. internalerror(2019081001);
  4301. sym.ExportByOrdinal:=True;
  4302. sym.ExportOrdinal:=NextOrdinal;
  4303. Inc(NextOrdinal);
  4304. end;
  4305. end;
  4306. end;
  4307. end;
  4308. procedure TNewExeOutput.AddEntryPointsForAllExportSymbols;
  4309. var
  4310. LastOrdinal: Word;
  4311. i, j: Integer;
  4312. ObjData: TOmfObjData;
  4313. sym: TOmfObjExportedSymbol;
  4314. ent: TNewExeEntryPoint;
  4315. exesym: TExeSymbol;
  4316. sec: TNewExeSection;
  4317. begin
  4318. LastOrdinal:=GetHighestExportSymbolOrdinal;
  4319. EntryTable.GrowTo(LastOrdinal);
  4320. for i:=0 to ObjDataList.Count-1 do
  4321. begin
  4322. ObjData:=TOmfObjData(ObjDataList[i]);
  4323. for j:=0 to ObjData.ExportedSymbolList.Count-1 do
  4324. begin
  4325. sym:=TOmfObjExportedSymbol(ObjData.ExportedSymbolList[j]);
  4326. { all exports must have an ordinal at this point }
  4327. if not sym.ExportByOrdinal then
  4328. internalerror(2019081004);
  4329. { check for duplicated ordinals }
  4330. if Assigned(EntryTable[sym.ExportOrdinal]) then
  4331. internalerror(2019081005);
  4332. ent:=TNewExeEntryPoint.Create;
  4333. EntryTable[sym.ExportOrdinal]:=ent;
  4334. exesym:=TExeSymbol(ExeSymbolList.Find(sym.InternalName));
  4335. if not Assigned(exesym) then
  4336. internalerror(2019081006);
  4337. ent.Flags:=[neepfExported];
  4338. if IsSharedLibrary then
  4339. ent.Flags:=ent.Flags+[neepfSingleData];
  4340. ent.Offset:=exesym.ObjSymbol.address;
  4341. sec:=TNewExeSection(exesym.ObjSymbol.objsection.ExeSection);
  4342. ent.Segment:=sec.MemBasePos;
  4343. if nesfMovable in sec.NewExeSegmentFlags then
  4344. ent.Flags:=ent.Flags+[neepfMovableSegment];
  4345. ent.ParmCount:=sym.ParmCount;
  4346. end;
  4347. end;
  4348. end;
  4349. procedure TNewExeOutput.AddExportedNames;
  4350. var
  4351. i, j: Integer;
  4352. ObjData: TOmfObjData;
  4353. sym: TOmfObjExportedSymbol;
  4354. begin
  4355. for i:=0 to ObjDataList.Count-1 do
  4356. begin
  4357. ObjData:=TOmfObjData(ObjDataList[i]);
  4358. for j:=0 to ObjData.ExportedSymbolList.Count-1 do
  4359. begin
  4360. sym:=TOmfObjExportedSymbol(ObjData.ExportedSymbolList[j]);
  4361. { all exports must have an ordinal at this point }
  4362. if not sym.ExportByOrdinal then
  4363. internalerror(2019081007);
  4364. if sym.ResidentName then
  4365. TNewExeExportNameTableEntry.Create(ResidentNameTable,sym.ExportedName,sym.ExportOrdinal)
  4366. else
  4367. TNewExeExportNameTableEntry.Create(NonresidentNameTable,sym.ExportedName,sym.ExportOrdinal);
  4368. end;
  4369. end;
  4370. end;
  4371. procedure TNewExeOutput.DoRelocationFixup(objsec: TObjSection);
  4372. begin
  4373. {todo}
  4374. end;
  4375. function INewExeOmfObjSectionClassNameCompare(Item1, Item2: Pointer): Integer;
  4376. var
  4377. I1 : TOmfObjSection absolute Item1;
  4378. I2 : TOmfObjSection absolute Item2;
  4379. begin
  4380. Result:=CompareStr(I1.ClassName,I2.ClassName);
  4381. if Result=0 then
  4382. Result:=CompareStr(I1.Name,I2.Name);
  4383. if Result=0 then
  4384. Result:=I1.SortOrder-I2.SortOrder;
  4385. end;
  4386. procedure TNewExeOutput.Order_ObjSectionList(ObjSectionList: TFPObjectList;const aPattern: string);
  4387. var
  4388. i: Integer;
  4389. begin
  4390. for i:=0 to ObjSectionList.Count-1 do
  4391. TOmfObjSection(ObjSectionList[i]).SortOrder:=i;
  4392. ObjSectionList.Sort(@INewExeOmfObjSectionClassNameCompare);
  4393. end;
  4394. constructor TNewExeOutput.create;
  4395. begin
  4396. inherited create;
  4397. CObjData:=TOmfObjData;
  4398. CObjSymbol:=TOmfObjSymbol;
  4399. CExeSection:=TNewExeSection;
  4400. FHeader:=TNewExeHeader.Create;
  4401. MaxMemPos:=$FFFFFFFF;
  4402. CurrExeMetaSec:=nemsNone;
  4403. FResourceTable:=TNewExeResourceTable.Create;
  4404. FResidentNameTable:=TNewExeExportNameTable.Create;
  4405. FNonresidentNameTable:=TNewExeExportNameTable.Create;
  4406. FModuleReferenceTable:=TNewExeModuleReferenceTable.Create;
  4407. FImportedNameTable:=TNewExeImportedNameTable.Create;
  4408. FEntryTable:=TNewExeEntryTable.Create;
  4409. end;
  4410. destructor TNewExeOutput.destroy;
  4411. begin
  4412. FEntryTable.Free;
  4413. FImportedNameTable.Free;
  4414. FModuleReferenceTable.Free;
  4415. FNonresidentNameTable.Free;
  4416. FResidentNameTable.Free;
  4417. FResourceTable.Free;
  4418. FHeader.Free;
  4419. inherited destroy;
  4420. end;
  4421. procedure TNewExeOutput.Order_ExeSection(const aname: string);
  4422. begin
  4423. case aname of
  4424. '.NE_code':
  4425. CurrExeMetaSec:=nemsCode;
  4426. '.NE_data':
  4427. CurrExeMetaSec:=nemsData;
  4428. else
  4429. internalerror(2019080201);
  4430. end;
  4431. end;
  4432. procedure TNewExeOutput.Order_EndExeSection;
  4433. begin
  4434. CurrExeMetaSec:=nemsNone;
  4435. inherited;
  4436. end;
  4437. procedure TNewExeOutput.Order_ObjSection(const aname: string);
  4438. const
  4439. SegmentLimit=$10000;
  4440. var
  4441. i,j : longint;
  4442. ObjData : TObjData;
  4443. objsec : TObjSection;
  4444. TmpObjSectionList : TFPObjectList;
  4445. begin
  4446. if CurrExeMetaSec=nemsNone then
  4447. internalerror(2019080202);
  4448. if not assigned (CurrExeSec) then
  4449. AddNewExeSection;
  4450. TmpObjSectionList:=TFPObjectList.Create(false);
  4451. for i:=0 to ObjDataList.Count-1 do
  4452. begin
  4453. ObjData:=TObjData(ObjDataList[i]);
  4454. for j:=0 to ObjData.ObjSectionList.Count-1 do
  4455. begin
  4456. objsec:=TObjSection(ObjData.ObjSectionList[j]);
  4457. if (not objsec.Used) and
  4458. MatchPattern(aname,objsec.name) then
  4459. TmpObjSectionList.Add(objsec);
  4460. end;
  4461. end;
  4462. { Order list if needed }
  4463. Order_ObjSectionList(TmpObjSectionList,aname);
  4464. { Add the (ordered) list to the current ExeSection }
  4465. for i:=0 to TmpObjSectionList.Count-1 do
  4466. begin
  4467. objsec:=TObjSection(TmpObjSectionList[i]);
  4468. { If there's no room left in the current section, create a new one }
  4469. if not TNewExeSection(CurrExeSec).CanAddObjSection(objsec,SegmentLimit) then
  4470. AddNewExeSection;
  4471. CurrExeSec.AddObjSection(objsec);
  4472. end;
  4473. TmpObjSectionList.Free;
  4474. end;
  4475. procedure TNewExeOutput.MemPos_Start;
  4476. var
  4477. i: Integer;
  4478. begin
  4479. inherited MemPos_Start;
  4480. for i:=0 to ExeSectionList.Count-1 do
  4481. begin
  4482. MemPos_ExeSection(TExeSection(ExeSectionList[i]));
  4483. CurrMemPos:=0;
  4484. end;
  4485. end;
  4486. procedure TNewExeOutput.GenerateLibraryImports(ImportLibraryList: TFPHashObjectList);
  4487. var
  4488. i,j: longint;
  4489. ImportLibrary: TImportLibrary;
  4490. ImportSymbol: TImportSymbol;
  4491. exesym: TExeSymbol;
  4492. begin
  4493. FImports:=ImportLibraryList;
  4494. AddImportLibrariesExtractedFromObjectModules;
  4495. for i:=0 to FImports.Count-1 do
  4496. begin
  4497. ImportLibrary:=TImportLibrary(FImports[i]);
  4498. for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do
  4499. begin
  4500. ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
  4501. exesym:=TExeSymbol(ExeSymbolList.Find(ImportSymbol.MangledName));
  4502. if assigned(exesym) and
  4503. (exesym.State<>symstate_defined) then
  4504. begin
  4505. ImportSymbol.CachedExeSymbol:=exesym;
  4506. exesym.State:=symstate_defined;
  4507. end;
  4508. end;
  4509. end;
  4510. PackUnresolvedExeSymbols('after DLL imports');
  4511. end;
  4512. function TNewExeOutput.writeData: boolean;
  4513. begin
  4514. Result:=False;
  4515. if ExeWriteMode in [ewm_exefull,ewm_exeonly] then
  4516. begin
  4517. Result:=WriteNewExe;
  4518. if not Result then
  4519. exit;
  4520. end;
  4521. end;
  4522. {****************************************************************************
  4523. TOmfAssembler
  4524. ****************************************************************************}
  4525. constructor TOmfAssembler.Create(info: pasminfo; smart:boolean);
  4526. begin
  4527. inherited;
  4528. CObjOutput:=TOmfObjOutput;
  4529. CInternalAr:=TOmfLibObjectWriter;
  4530. end;
  4531. {*****************************************************************************
  4532. Procedures and functions
  4533. *****************************************************************************}
  4534. function StripDllExt(const DllName:TSymStr):TSymStr;
  4535. begin
  4536. if UpCase(ExtractFileExt(DllName))='.DLL' then
  4537. Result:=Copy(DllName,1,Length(DllName)-4)
  4538. else
  4539. Result:=DllName;
  4540. end;
  4541. function MaybeAddDllExt(const DllName: TSymStr): TSymStr;
  4542. begin
  4543. if ExtractFileExt(DllName)='' then
  4544. Result:=ChangeFileExt(DllName,'.dll')
  4545. else
  4546. Result:=DllName;
  4547. end;
  4548. {*****************************************************************************
  4549. Initialize
  4550. *****************************************************************************}
  4551. {$ifdef i8086}
  4552. const
  4553. as_i8086_omf_info : tasminfo =
  4554. (
  4555. id : as_i8086_omf;
  4556. idtxt : 'OMF';
  4557. asmbin : '';
  4558. asmcmd : '';
  4559. supported_targets : [system_i8086_msdos,system_i8086_embedded,system_i8086_win16];
  4560. flags : [af_outputbinary,af_smartlink_sections];
  4561. labelprefix : '..@';
  4562. comment : '; ';
  4563. dollarsign: '$';
  4564. );
  4565. {$endif i8086}
  4566. initialization
  4567. {$ifdef i8086}
  4568. RegisterAssembler(as_i8086_omf_info,TOmfAssembler);
  4569. {$endif i8086}
  4570. end.