ogomf.pas 99 KB

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