ogomf.pas 121 KB

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