ogomf.pas 165 KB

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