2
0

ogomf.pas 185 KB

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