ogomf.pas 121 KB

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