ogomf.pas 108 KB

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