ogomf.pas 167 KB

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