ogomf.pas 102 KB

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