ogomf.pas 147 KB

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