ogomf.pas 160 KB

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