ogomf.pas 96 KB

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