ogomf.pas 178 KB

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