ogomf.pas 179 KB

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