ogomf.pas 135 KB

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