ogomf.pas 114 KB

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