ogomf.pas 101 KB

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