ogomf.pas 101 KB

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