ogomf.pas 109 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924
  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. PublicNameElem.IsLocal:=False;
  825. end
  826. else if objsym.bind=AB_LOCAL then
  827. begin
  828. PublicNameElem:=TOmfPublicNameElement.Create(PubNamesForSection[objsym.objsection.index-1],objsym.Name);
  829. PublicNameElem.PublicOffset:=objsym.offset;
  830. PublicNameElem.IsLocal:=True;
  831. end
  832. end;
  833. for i:=0 to Data.ObjSectionList.Count-1 do
  834. if PubNamesForSection[i].Count>0 then
  835. begin
  836. PubDefRec:=TOmfRecord_PUBDEF.Create;
  837. PubDefRec.BaseSegmentIndex:=i+1;
  838. PrimaryGroupName:=TOmfObjSection(Data.ObjSectionList[i]).PrimaryGroup;
  839. if PrimaryGroupName<>'' then
  840. PubDefRec.BaseGroupIndex:=Groups.FindIndexOf(PrimaryGroupName)
  841. else
  842. PubDefRec.BaseGroupIndex:=0;
  843. PubDefRec.PublicNames:=PubNamesForSection[i];
  844. while PubDefRec.NextIndex<PubDefRec.PublicNames.Count do
  845. begin
  846. PubDefRec.EncodeTo(RawRecord);
  847. RawRecord.WriteTo(FWriter);
  848. end;
  849. PubDefRec.Free;
  850. end;
  851. for i:=0 to Data.ObjSectionList.Count-1 do
  852. FreeAndNil(PubNamesForSection[i]);
  853. RawRecord.Free;
  854. end;
  855. procedure TOmfObjOutput.WriteEXTDEFs(Data: TObjData);
  856. var
  857. ExtNames: TFPHashObjectList;
  858. RawRecord: TOmfRawRecord;
  859. i,idx: Integer;
  860. objsym: TObjSymbol;
  861. ExternalNameElem: TOmfExternalNameElement;
  862. ExtDefRec: TOmfRecord_EXTDEF;
  863. begin
  864. ExtNames:=TFPHashObjectList.Create;
  865. RawRecord:=TOmfRawRecord.Create;
  866. idx:=1;
  867. for i:=0 to Data.ObjSymbolList.Count-1 do
  868. begin
  869. objsym:=TObjSymbol(Data.ObjSymbolList[i]);
  870. if objsym.bind=AB_EXTERNAL then
  871. begin
  872. ExternalNameElem:=TOmfExternalNameElement.Create(ExtNames,objsym.Name);
  873. objsym.symidx:=idx;
  874. Inc(idx);
  875. end;
  876. end;
  877. if ExtNames.Count>0 then
  878. begin
  879. ExtDefRec:=TOmfRecord_EXTDEF.Create;
  880. ExtDefRec.ExternalNames:=ExtNames;
  881. while ExtDefRec.NextIndex<ExtDefRec.ExternalNames.Count do
  882. begin
  883. ExtDefRec.EncodeTo(RawRecord);
  884. RawRecord.WriteTo(FWriter);
  885. end;
  886. ExtDefRec.Free;
  887. end;
  888. ExtNames.Free;
  889. RawRecord.Free;
  890. end;
  891. function TOmfObjOutput.writeData(Data:TObjData):boolean;
  892. var
  893. RawRecord: TOmfRawRecord;
  894. Header: TOmfRecord_THEADR;
  895. Translator_COMENT: TOmfRecord_COMENT;
  896. DebugFormat_COMENT: TOmfRecord_COMENT;
  897. LinkPassSeparator_COMENT: TOmfRecord_COMENT;
  898. LNamesRec: TOmfRecord_LNAMES;
  899. ModEnd: TOmfRecord_MODEND;
  900. I: Integer;
  901. SegDef: TOmfRecord_SEGDEF;
  902. GrpDef: TOmfRecord_GRPDEF;
  903. DGroupSegments: TSegmentList;
  904. nsections: Integer;
  905. objsym: TObjSymbol;
  906. begin
  907. { calc amount of sections we have and set their index, starting with 1 }
  908. nsections:=1;
  909. data.ObjSectionList.ForEachCall(@section_count_sections,@nsections);
  910. { maximum amount of sections supported in the omf format is $7fff }
  911. if (nsections-1)>$7fff then
  912. internalerror(2015040701);
  913. { write header record }
  914. RawRecord:=TOmfRawRecord.Create;
  915. Header:=TOmfRecord_THEADR.Create;
  916. if cs_debuginfo in current_settings.moduleswitches then
  917. Header.ModuleName:=TOmfObjData(Data).MainSource
  918. else
  919. Header.ModuleName:=Data.Name;
  920. Header.EncodeTo(RawRecord);
  921. RawRecord.WriteTo(FWriter);
  922. Header.Free;
  923. { write translator COMENT header }
  924. Translator_COMENT:=TOmfRecord_COMENT.Create;
  925. Translator_COMENT.CommentClass:=CC_Translator;
  926. Translator_COMENT.CommentString:='FPC '+full_version_string+
  927. ' ['+date_string+'] for '+target_cpu_string+' - '+target_info.shortname;
  928. Translator_COMENT.EncodeTo(RawRecord);
  929. RawRecord.WriteTo(FWriter);
  930. Translator_COMENT.Free;
  931. if (target_dbg.id=dbg_codeview) or
  932. ((ds_dwarf_omf_linnum in current_settings.debugswitches) and
  933. (target_dbg.id in [dbg_dwarf2,dbg_dwarf3,dbg_dwarf4])) then
  934. begin
  935. DebugFormat_COMENT:=TOmfRecord_COMENT.Create;
  936. DebugFormat_COMENT.CommentClass:=CC_NewOmfExtension;
  937. DebugFormat_COMENT.CommentString:='';
  938. DebugFormat_COMENT.EncodeTo(RawRecord);
  939. RawRecord.WriteTo(FWriter);
  940. DebugFormat_COMENT.Free;
  941. end;
  942. LNames.Clear;
  943. LNames.Add(''); { insert an empty string, which has index 1 }
  944. FSegments.Clear;
  945. FSegments.Add('',nil);
  946. FGroups.Clear;
  947. FGroups.Add('',nil);
  948. for i:=0 to Data.ObjSectionList.Count-1 do
  949. with TOmfObjSection(Data.ObjSectionList[I]) do
  950. AddSegment(Name,ClassName,OverlayName,OmfAlignment,Combination,Use,Size);
  951. { create group "DGROUP" }
  952. SetLength(DGroupSegments,0);
  953. for i:=0 to Data.ObjSectionList.Count-1 do
  954. with TOmfObjSection(Data.ObjSectionList[I]) do
  955. if PrimaryGroup='DGROUP' then
  956. begin
  957. SetLength(DGroupSegments,Length(DGroupSegments)+1);
  958. DGroupSegments[High(DGroupSegments)]:=index;
  959. end;
  960. AddGroup('DGROUP',DGroupSegments);
  961. { write LNAMES record(s) }
  962. LNamesRec:=TOmfRecord_LNAMES.Create;
  963. LNamesRec.Names:=LNames;
  964. while LNamesRec.NextIndex<=LNames.Count do
  965. begin
  966. LNamesRec.EncodeTo(RawRecord);
  967. RawRecord.WriteTo(FWriter);
  968. end;
  969. LNamesRec.Free;
  970. { write SEGDEF record(s) }
  971. for I:=1 to Segments.Count-1 do
  972. begin
  973. SegDef:=TOmfRecord_SEGDEF(Segments[I]);
  974. SegDef.EncodeTo(RawRecord);
  975. RawRecord.WriteTo(FWriter);
  976. end;
  977. { write GRPDEF record(s) }
  978. for I:=1 to Groups.Count-1 do
  979. begin
  980. GrpDef:=TOmfRecord_GRPDEF(Groups[I]);
  981. GrpDef.EncodeTo(RawRecord);
  982. RawRecord.WriteTo(FWriter);
  983. end;
  984. { write PUBDEF record(s) }
  985. WritePUBDEFs(Data);
  986. { write EXTDEF record(s) }
  987. WriteEXTDEFs(Data);
  988. { write link pass separator }
  989. LinkPassSeparator_COMENT:=TOmfRecord_COMENT.Create;
  990. LinkPassSeparator_COMENT.CommentClass:=CC_LinkPassSeparator;
  991. LinkPassSeparator_COMENT.CommentString:=#1;
  992. LinkPassSeparator_COMENT.NoList:=True;
  993. LinkPassSeparator_COMENT.EncodeTo(RawRecord);
  994. RawRecord.WriteTo(FWriter);
  995. LinkPassSeparator_COMENT.Free;
  996. { write section content, interleaved with fixups }
  997. WriteSections(Data);
  998. { write MODEND record }
  999. ModEnd:=TOmfRecord_MODEND.Create;
  1000. ModEnd.EncodeTo(RawRecord);
  1001. RawRecord.WriteTo(FWriter);
  1002. ModEnd.Free;
  1003. RawRecord.Free;
  1004. result:=true;
  1005. end;
  1006. constructor TOmfObjOutput.create(AWriter:TObjectWriter);
  1007. begin
  1008. inherited create(AWriter);
  1009. cobjdata:=TOmfObjData;
  1010. FLNames:=TOmfOrderedNameCollection.Create(False);
  1011. FSegments:=TFPHashObjectList.Create;
  1012. FSegments.Add('',nil);
  1013. FGroups:=TFPHashObjectList.Create;
  1014. FGroups.Add('',nil);
  1015. end;
  1016. destructor TOmfObjOutput.Destroy;
  1017. begin
  1018. FGroups.Free;
  1019. FSegments.Free;
  1020. FLNames.Free;
  1021. inherited Destroy;
  1022. end;
  1023. procedure TOmfObjOutput.WriteDllImport(const dllname,afuncname,mangledname: string; ordnr: longint; isvar: boolean);
  1024. var
  1025. RawRecord: TOmfRawRecord;
  1026. Header: TOmfRecord_THEADR;
  1027. DllImport_COMENT: TOmfRecord_COMENT;
  1028. ModEnd: TOmfRecord_MODEND;
  1029. begin
  1030. { write header record }
  1031. RawRecord:=TOmfRawRecord.Create;
  1032. Header:=TOmfRecord_THEADR.Create;
  1033. Header.ModuleName:=mangledname;
  1034. Header.EncodeTo(RawRecord);
  1035. RawRecord.WriteTo(FWriter);
  1036. Header.Free;
  1037. { write IMPDEF record }
  1038. DllImport_COMENT:=TOmfRecord_COMENT.Create;
  1039. DllImport_COMENT.CommentClass:=CC_OmfExtension;
  1040. if ordnr <= 0 then
  1041. begin
  1042. if afuncname=mangledname then
  1043. DllImport_COMENT.CommentString:=#1#0+Chr(Length(mangledname))+mangledname+Chr(Length(dllname))+dllname+#0
  1044. else
  1045. DllImport_COMENT.CommentString:=#1#0+Chr(Length(mangledname))+mangledname+Chr(Length(dllname))+dllname+Chr(Length(afuncname))+afuncname;
  1046. end
  1047. else
  1048. DllImport_COMENT.CommentString:=#1#1+Chr(Length(mangledname))+mangledname+Chr(Length(dllname))+dllname+Chr(ordnr and $ff)+Chr((ordnr shr 8) and $ff);
  1049. DllImport_COMENT.EncodeTo(RawRecord);
  1050. RawRecord.WriteTo(FWriter);
  1051. DllImport_COMENT.Free;
  1052. { write MODEND record }
  1053. ModEnd:=TOmfRecord_MODEND.Create;
  1054. ModEnd.EncodeTo(RawRecord);
  1055. RawRecord.WriteTo(FWriter);
  1056. ModEnd.Free;
  1057. RawRecord.Free;
  1058. end;
  1059. {****************************************************************************
  1060. TOmfObjInput
  1061. ****************************************************************************}
  1062. function TOmfObjInput.PeekNextRecordType: Byte;
  1063. var
  1064. OldPos: LongInt;
  1065. begin
  1066. OldPos:=FReader.Pos;
  1067. if not FReader.read(Result, 1) then
  1068. begin
  1069. InputError('Unexpected end of file');
  1070. Result:=0;
  1071. exit;
  1072. end;
  1073. FReader.seek(OldPos);
  1074. end;
  1075. function TOmfObjInput.ReadLNames(RawRec: TOmfRawRecord): Boolean;
  1076. var
  1077. LNamesRec: TOmfRecord_LNAMES;
  1078. begin
  1079. Result:=False;
  1080. LNamesRec:=TOmfRecord_LNAMES.Create;
  1081. LNamesRec.Names:=LNames;
  1082. LNamesRec.DecodeFrom(RawRec);
  1083. LNamesRec.Free;
  1084. Result:=True;
  1085. end;
  1086. function TOmfObjInput.ReadSegDef(RawRec: TOmfRawRecord; objdata: TObjData): Boolean;
  1087. var
  1088. SegDefRec: TOmfRecord_SEGDEF;
  1089. SegmentName,SegClassName,OverlayName: string;
  1090. SecAlign: LongInt;
  1091. secoptions: TObjSectionOptions;
  1092. objsec: TOmfObjSection;
  1093. begin
  1094. Result:=False;
  1095. SegDefRec:=TOmfRecord_SEGDEF.Create;
  1096. SegDefRec.DecodeFrom(RawRec);
  1097. if (SegDefRec.SegmentNameIndex<1) or (SegDefRec.SegmentNameIndex>LNames.Count) then
  1098. begin
  1099. InputError('Segment name index out of range');
  1100. SegDefRec.Free;
  1101. exit;
  1102. end;
  1103. SegmentName:=LNames[SegDefRec.SegmentNameIndex];
  1104. if (SegDefRec.ClassNameIndex<1) or (SegDefRec.ClassNameIndex>LNames.Count) then
  1105. begin
  1106. InputError('Segment class name index out of range');
  1107. SegDefRec.Free;
  1108. exit;
  1109. end;
  1110. SegClassName:=LNames[SegDefRec.ClassNameIndex];
  1111. if (SegDefRec.OverlayNameIndex<1) or (SegDefRec.OverlayNameIndex>LNames.Count) then
  1112. begin
  1113. InputError('Segment overlay name index out of range');
  1114. SegDefRec.Free;
  1115. exit;
  1116. end;
  1117. OverlayName:=LNames[SegDefRec.OverlayNameIndex];
  1118. SecAlign:=1; // otherwise warning prohibits compilation
  1119. case SegDefRec.Alignment of
  1120. saRelocatableByteAligned:
  1121. SecAlign:=1;
  1122. saRelocatableWordAligned:
  1123. SecAlign:=2;
  1124. saRelocatableParaAligned:
  1125. SecAlign:=16;
  1126. saRelocatableDWordAligned:
  1127. SecAlign:=4;
  1128. saRelocatablePageAligned:
  1129. SecAlign:=256;
  1130. saNotSupported:
  1131. SecAlign:=4096;
  1132. saAbsolute:
  1133. begin
  1134. InputError('Absolute segment alignment not supported');
  1135. SegDefRec.Free;
  1136. exit;
  1137. end;
  1138. saNotDefined:
  1139. begin
  1140. InputError('Invalid (unsupported/undefined) OMF segment alignment');
  1141. SegDefRec.Free;
  1142. exit;
  1143. end;
  1144. end;
  1145. if not CaseSensitiveSegments then
  1146. begin
  1147. SegmentName:=UpCase(SegmentName);
  1148. SegClassName:=UpCase(SegClassName);
  1149. OverlayName:=UpCase(OverlayName);
  1150. end;
  1151. { hack for supporting object modules, generated by Borland's BINOBJ tool }
  1152. if (SegClassName='') and (SegmentName='CODE') then
  1153. begin
  1154. SegmentName:=InputFileName;
  1155. SegClassName:='CODE';
  1156. end;
  1157. secoptions:=[];
  1158. objsec:=TOmfObjSection(objdata.createsection(SegmentName+'||'+SegClassName,SecAlign,secoptions,false));
  1159. objsec.FClassName:=SegClassName;
  1160. objsec.FOverlayName:=OverlayName;
  1161. objsec.FCombination:=SegDefRec.Combination;
  1162. objsec.FUse:=SegDefRec.Use;
  1163. if SegDefRec.SegmentLength>High(objsec.Size) then
  1164. begin
  1165. InputError('Segment too large');
  1166. SegDefRec.Free;
  1167. exit;
  1168. end;
  1169. objsec.Size:=SegDefRec.SegmentLength;
  1170. if (SegClassName='HEAP') or
  1171. (SegClassName='STACK') or (SegDefRec.Combination=scStack) or
  1172. (SegClassName='BEGDATA') or
  1173. (SegmentName='FPC') then
  1174. objsec.SecOptions:=objsec.SecOptions+[oso_keep];
  1175. SegDefRec.Free;
  1176. Result:=True;
  1177. end;
  1178. function TOmfObjInput.ReadGrpDef(RawRec: TOmfRawRecord; objdata: TObjData): Boolean;
  1179. var
  1180. GrpDefRec: TOmfRecord_GRPDEF;
  1181. GroupName: string;
  1182. SecGroup: TObjSectionGroup;
  1183. i,SegIndex: Integer;
  1184. begin
  1185. Result:=False;
  1186. GrpDefRec:=TOmfRecord_GRPDEF.Create;
  1187. GrpDefRec.DecodeFrom(RawRec);
  1188. if (GrpDefRec.GroupNameIndex<1) or (GrpDefRec.GroupNameIndex>LNames.Count) then
  1189. begin
  1190. InputError('Group name index out of range');
  1191. GrpDefRec.Free;
  1192. exit;
  1193. end;
  1194. GroupName:=LNames[GrpDefRec.GroupNameIndex];
  1195. if not CaseSensitiveSegments then
  1196. GroupName:=UpCase(GroupName);
  1197. SecGroup:=objdata.createsectiongroup(GroupName);
  1198. SetLength(SecGroup.members,Length(GrpDefRec.SegmentList));
  1199. for i:=0 to Length(GrpDefRec.SegmentList)-1 do
  1200. begin
  1201. SegIndex:=GrpDefRec.SegmentList[i];
  1202. if (SegIndex<1) or (SegIndex>objdata.ObjSectionList.Count) then
  1203. begin
  1204. InputError('Segment name index out of range in group definition');
  1205. GrpDefRec.Free;
  1206. exit;
  1207. end;
  1208. SecGroup.members[i]:=TOmfObjSection(objdata.ObjSectionList[SegIndex-1]);
  1209. end;
  1210. GrpDefRec.Free;
  1211. Result:=True;
  1212. end;
  1213. function TOmfObjInput.ReadExtDef(RawRec: TOmfRawRecord; objdata: TObjData): Boolean;
  1214. var
  1215. ExtDefRec: TOmfRecord_EXTDEF;
  1216. ExtDefElem: TOmfExternalNameElement;
  1217. OldCount,NewCount,i: Integer;
  1218. objsym: TObjSymbol;
  1219. symname: TSymStr;
  1220. begin
  1221. Result:=False;
  1222. ExtDefRec:=TOmfRecord_EXTDEF.Create;
  1223. ExtDefRec.ExternalNames:=ExtDefs;
  1224. OldCount:=ExtDefs.Count;
  1225. ExtDefRec.DecodeFrom(RawRec);
  1226. NewCount:=ExtDefs.Count;
  1227. for i:=OldCount to NewCount-1 do
  1228. begin
  1229. ExtDefElem:=TOmfExternalNameElement(ExtDefs[i]);
  1230. symname:=ExtDefElem.Name;
  1231. if not CaseSensitiveSymbols then
  1232. symname:=UpCase(symname);
  1233. objsym:=objdata.CreateSymbol(symname);
  1234. objsym.bind:=AB_EXTERNAL;
  1235. objsym.typ:=AT_FUNCTION;
  1236. objsym.objsection:=nil;
  1237. objsym.offset:=0;
  1238. objsym.size:=0;
  1239. end;
  1240. ExtDefRec.Free;
  1241. Result:=True;
  1242. end;
  1243. function TOmfObjInput.ReadPubDef(RawRec: TOmfRawRecord; objdata:TObjData): Boolean;
  1244. var
  1245. PubDefRec: TOmfRecord_PUBDEF;
  1246. PubDefElem: TOmfPublicNameElement;
  1247. OldCount,NewCount,i: Integer;
  1248. basegroup: TObjSectionGroup;
  1249. objsym: TObjSymbol;
  1250. objsec: TOmfObjSection;
  1251. symname: TSymStr;
  1252. begin
  1253. Result:=False;
  1254. PubDefRec:=TOmfRecord_PUBDEF.Create;
  1255. PubDefRec.PublicNames:=PubDefs;
  1256. OldCount:=PubDefs.Count;
  1257. PubDefRec.DecodeFrom(RawRec);
  1258. NewCount:=PubDefs.Count;
  1259. if (PubDefRec.BaseGroupIndex<0) or (PubDefRec.BaseGroupIndex>objdata.GroupsList.Count) then
  1260. begin
  1261. InputError('Public symbol''s group name index out of range');
  1262. PubDefRec.Free;
  1263. exit;
  1264. end;
  1265. if PubDefRec.BaseGroupIndex<>0 then
  1266. basegroup:=TObjSectionGroup(objdata.GroupsList[PubDefRec.BaseGroupIndex-1])
  1267. else
  1268. basegroup:=nil;
  1269. if (PubDefRec.BaseSegmentIndex<0) or (PubDefRec.BaseSegmentIndex>objdata.ObjSectionList.Count) then
  1270. begin
  1271. InputError('Public symbol''s segment name index out of range');
  1272. PubDefRec.Free;
  1273. exit;
  1274. end;
  1275. if PubDefRec.BaseSegmentIndex=0 then
  1276. begin
  1277. InputError('Public symbol uses absolute addressing, which is not supported by this linker');
  1278. PubDefRec.Free;
  1279. exit;
  1280. end;
  1281. objsec:=TOmfObjSection(objdata.ObjSectionList[PubDefRec.BaseSegmentIndex-1]);
  1282. for i:=OldCount to NewCount-1 do
  1283. begin
  1284. PubDefElem:=TOmfPublicNameElement(PubDefs[i]);
  1285. symname:=PubDefElem.Name;
  1286. if not CaseSensitiveSymbols then
  1287. symname:=UpCase(symname);
  1288. objsym:=objdata.CreateSymbol(symname);
  1289. if PubDefElem.IsLocal then
  1290. objsym.bind:=AB_LOCAL
  1291. else
  1292. objsym.bind:=AB_GLOBAL;
  1293. objsym.typ:=AT_FUNCTION;
  1294. objsym.group:=basegroup;
  1295. objsym.objsection:=objsec;
  1296. objsym.offset:=PubDefElem.PublicOffset;
  1297. objsym.size:=0;
  1298. end;
  1299. PubDefRec.Free;
  1300. Result:=True;
  1301. end;
  1302. function TOmfObjInput.ReadModEnd(RawRec: TOmfRawRecord; objdata:TObjData): Boolean;
  1303. var
  1304. ModEndRec: TOmfRecord_MODEND;
  1305. objsym: TObjSymbol;
  1306. objsec: TOmfObjSection;
  1307. basegroup: TObjSectionGroup;
  1308. begin
  1309. Result:=False;
  1310. ModEndRec:=TOmfRecord_MODEND.Create;
  1311. ModEndRec.DecodeFrom(RawRec);
  1312. if ModEndRec.HasStartAddress then
  1313. begin
  1314. if not ModEndRec.LogicalStartAddress then
  1315. begin
  1316. InputError('Physical start address not supported');
  1317. ModEndRec.Free;
  1318. exit;
  1319. end;
  1320. if not (ModEndRec.TargetMethod in [ftmSegmentIndex,ftmSegmentIndexNoDisp]) then
  1321. begin
  1322. InputError('Target method for start address other than "Segment Index" is not supported');
  1323. ModEndRec.Free;
  1324. exit;
  1325. end;
  1326. if (ModEndRec.TargetDatum<1) or (ModEndRec.TargetDatum>objdata.ObjSectionList.Count) then
  1327. begin
  1328. InputError('Segment name index for start address out of range');
  1329. ModEndRec.Free;
  1330. exit;
  1331. end;
  1332. case ModEndRec.FrameMethod of
  1333. ffmSegmentIndex:
  1334. begin
  1335. if (ModEndRec.FrameDatum<1) or (ModEndRec.FrameDatum>objdata.ObjSectionList.Count) then
  1336. begin
  1337. InputError('Frame segment name index for start address out of range');
  1338. ModEndRec.Free;
  1339. exit;
  1340. end;
  1341. if ModEndRec.FrameDatum<>ModEndRec.TargetDatum then
  1342. begin
  1343. InputError('Frame segment different than target segment is not supported supported for start address');
  1344. ModEndRec.Free;
  1345. exit;
  1346. end;
  1347. basegroup:=nil;
  1348. end;
  1349. ffmGroupIndex:
  1350. begin
  1351. if (ModEndRec.FrameDatum<1) or (ModEndRec.FrameDatum>objdata.GroupsList.Count) then
  1352. begin
  1353. InputError('Frame group name index for start address out of range');
  1354. ModEndRec.Free;
  1355. exit;
  1356. end;
  1357. basegroup:=TObjSectionGroup(objdata.GroupsList[ModEndRec.FrameDatum-1]);
  1358. end;
  1359. else
  1360. begin
  1361. InputError('Frame method for start address other than "Segment Index" or "Group Index" is not supported');
  1362. ModEndRec.Free;
  1363. exit;
  1364. end;
  1365. end;
  1366. objsec:=TOmfObjSection(objdata.ObjSectionList[ModEndRec.TargetDatum-1]);
  1367. objsym:=objdata.CreateSymbol('..start');
  1368. objsym.bind:=AB_GLOBAL;
  1369. objsym.typ:=AT_FUNCTION;
  1370. objsym.group:=basegroup;
  1371. objsym.objsection:=objsec;
  1372. objsym.offset:=ModEndRec.TargetDisplacement;
  1373. objsym.size:=0;
  1374. end;
  1375. ModEndRec.Free;
  1376. Result:=True;
  1377. end;
  1378. function TOmfObjInput.ReadLeOrLiDataAndFixups(RawRec: TOmfRawRecord; objdata: TObjData): Boolean;
  1379. var
  1380. Is32Bit: Boolean;
  1381. NextOfs: Integer;
  1382. SegmentIndex: Integer;
  1383. EnumeratedDataOffset: DWord;
  1384. BlockLength: Integer;
  1385. objsec: TOmfObjSection;
  1386. FixupRawRec: TOmfRawRecord=nil;
  1387. Fixup: TOmfSubRecord_FIXUP;
  1388. Thread: TOmfSubRecord_THREAD;
  1389. FixuppWithoutLeOrLiData: Boolean=False;
  1390. begin
  1391. Result:=False;
  1392. case RawRec.RecordType of
  1393. RT_LEDATA,RT_LEDATA32:
  1394. begin
  1395. Is32Bit:=RawRec.RecordType=RT_LEDATA32;
  1396. NextOfs:=RawRec.ReadIndexedRef(0,SegmentIndex);
  1397. if Is32Bit then
  1398. begin
  1399. if (NextOfs+3)>=RawRec.RecordLength then
  1400. internalerror(2015040504);
  1401. EnumeratedDataOffset := RawRec.RawData[NextOfs]+
  1402. (RawRec.RawData[NextOfs+1] shl 8)+
  1403. (RawRec.RawData[NextOfs+2] shl 16)+
  1404. (RawRec.RawData[NextOfs+3] shl 24);
  1405. Inc(NextOfs,4);
  1406. end
  1407. else
  1408. begin
  1409. if (NextOfs+1)>=RawRec.RecordLength then
  1410. internalerror(2015040504);
  1411. EnumeratedDataOffset := RawRec.RawData[NextOfs]+
  1412. (RawRec.RawData[NextOfs+1] shl 8);
  1413. Inc(NextOfs,2);
  1414. end;
  1415. BlockLength:=RawRec.RecordLength-NextOfs-1;
  1416. if BlockLength<0 then
  1417. internalerror(2015060501);
  1418. if BlockLength>1024 then
  1419. begin
  1420. InputError('LEDATA contains more than 1024 bytes of data');
  1421. exit;
  1422. end;
  1423. if (SegmentIndex<1) or (SegmentIndex>objdata.ObjSectionList.Count) then
  1424. begin
  1425. InputError('Segment index in LEDATA field is out of range');
  1426. exit;
  1427. end;
  1428. objsec:=TOmfObjSection(objdata.ObjSectionList[SegmentIndex-1]);
  1429. objsec.SecOptions:=objsec.SecOptions+[oso_Data];
  1430. if (objsec.Data.Size>EnumeratedDataOffset) then
  1431. begin
  1432. InputError('LEDATA enumerated data offset field out of sequence');
  1433. exit;
  1434. end;
  1435. if (EnumeratedDataOffset+BlockLength)>objsec.Size then
  1436. begin
  1437. InputError('LEDATA goes beyond the segment size declared in the SEGDEF record');
  1438. exit;
  1439. end;
  1440. objsec.Data.seek(EnumeratedDataOffset);
  1441. objsec.Data.write(RawRec.RawData[NextOfs],BlockLength);
  1442. end;
  1443. RT_LIDATA,RT_LIDATA32:
  1444. begin
  1445. InputError('LIDATA records are not supported');
  1446. exit;
  1447. end;
  1448. RT_FIXUPP,RT_FIXUPP32:
  1449. begin
  1450. FixuppWithoutLeOrLiData:=True;
  1451. { a hack, used to indicate, that we must process this record }
  1452. { (RawRec) first in the FIXUPP record processing loop that follows }
  1453. FixupRawRec:=RawRec;
  1454. end;
  1455. else
  1456. internalerror(2015040301);
  1457. end;
  1458. { also read all the FIXUPP records that may follow; }
  1459. { (FixupRawRec=RawRec) indicates that we must process RawRec first, but }
  1460. { without freeing it }
  1461. while (FixupRawRec=RawRec) or (PeekNextRecordType in [RT_FIXUPP,RT_FIXUPP32]) do
  1462. begin
  1463. if FixupRawRec<>RawRec then
  1464. begin
  1465. FixupRawRec:=TOmfRawRecord.Create;
  1466. FixupRawRec.ReadFrom(FReader);
  1467. if not FRawRecord.VerifyChecksumByte then
  1468. begin
  1469. InputError('Invalid checksum in OMF record');
  1470. FixupRawRec.Free;
  1471. exit;
  1472. end;
  1473. end;
  1474. NextOfs:=0;
  1475. Thread:=TOmfSubRecord_THREAD.Create;
  1476. Fixup:=TOmfSubRecord_FIXUP.Create;
  1477. Fixup.Is32Bit:=FixupRawRec.RecordType=RT_FIXUPP32;
  1478. Fixup.DataRecordStartOffset:=EnumeratedDataOffset;
  1479. while NextOfs<(FixupRawRec.RecordLength-1) do
  1480. begin
  1481. if (FixupRawRec.RawData[NextOfs] and $80)<>0 then
  1482. begin
  1483. { FIXUP subrecord }
  1484. if FixuppWithoutLeOrLiData then
  1485. begin
  1486. InputError('FIXUP subrecord without previous LEDATA or LIDATA record');
  1487. Fixup.Free;
  1488. Thread.Free;
  1489. if FixupRawRec<>RawRec then
  1490. FixupRawRec.Free;
  1491. exit;
  1492. end;
  1493. NextOfs:=Fixup.ReadAt(FixupRawRec,NextOfs);
  1494. Fixup.ResolveByThread(FFixupThreads);
  1495. ImportOmfFixup(objdata,objsec,Fixup);
  1496. end
  1497. else
  1498. begin
  1499. { THREAD subrecord }
  1500. NextOfs:=Thread.ReadAt(FixupRawRec,NextOfs);
  1501. Thread.ApplyTo(FFixupThreads);
  1502. end;
  1503. end;
  1504. Fixup.Free;
  1505. Thread.Free;
  1506. if FixupRawRec<>RawRec then
  1507. FixupRawRec.Free;
  1508. { always set it to null, so that we read the next record on the next }
  1509. { loop iteration (this ensures that FixupRawRec<>RawRec, without }
  1510. { freeing RawRec) }
  1511. FixupRawRec:=nil;
  1512. end;
  1513. Result:=True;
  1514. end;
  1515. function TOmfObjInput.ImportOmfFixup(objdata: TObjData; objsec: TOmfObjSection; Fixup: TOmfSubRecord_FIXUP): Boolean;
  1516. var
  1517. reloc: TOmfRelocation;
  1518. sym: TObjSymbol;
  1519. RelocType: TObjRelocationType;
  1520. target_section: TOmfObjSection;
  1521. target_group: TObjSectionGroup;
  1522. begin
  1523. Result:=False;
  1524. { range check location }
  1525. if (Fixup.LocationOffset+Fixup.LocationSize)>objsec.Size then
  1526. begin
  1527. InputError('Fixup location exceeds the current segment boundary');
  1528. exit;
  1529. end;
  1530. { range check target datum }
  1531. case Fixup.TargetMethod of
  1532. ftmSegmentIndex:
  1533. if (Fixup.TargetDatum<1) or (Fixup.TargetDatum>objdata.ObjSectionList.Count) then
  1534. begin
  1535. InputError('Segment name index in SI(<segment name>),<displacement> fixup target is out of range');
  1536. exit;
  1537. end;
  1538. ftmSegmentIndexNoDisp:
  1539. if (Fixup.TargetDatum<1) or (Fixup.TargetDatum>objdata.ObjSectionList.Count) then
  1540. begin
  1541. InputError('Segment name index in SI(<segment name>) fixup target is out of range');
  1542. exit;
  1543. end;
  1544. ftmGroupIndex:
  1545. if (Fixup.TargetDatum<1) or (Fixup.TargetDatum>objdata.GroupsList.Count) then
  1546. begin
  1547. InputError('Group name index in GI(<group name>),<displacement> fixup target is out of range');
  1548. exit;
  1549. end;
  1550. ftmGroupIndexNoDisp:
  1551. if (Fixup.TargetDatum<1) or (Fixup.TargetDatum>objdata.GroupsList.Count) then
  1552. begin
  1553. InputError('Group name index in GI(<group name>) fixup target is out of range');
  1554. exit;
  1555. end;
  1556. ftmExternalIndex:
  1557. if (Fixup.TargetDatum<1) or (Fixup.TargetDatum>ExtDefs.Count) then
  1558. begin
  1559. InputError('External symbol name index in EI(<symbol name>),<displacement> fixup target is out of range');
  1560. exit;
  1561. end;
  1562. ftmExternalIndexNoDisp:
  1563. if (Fixup.TargetDatum<1) or (Fixup.TargetDatum>ExtDefs.Count) then
  1564. begin
  1565. InputError('External symbol name index in EI(<symbol name>) fixup target is out of range');
  1566. exit;
  1567. end;
  1568. end;
  1569. { range check frame datum }
  1570. case Fixup.FrameMethod of
  1571. ffmSegmentIndex:
  1572. if (Fixup.FrameDatum<1) or (Fixup.FrameDatum>objdata.ObjSectionList.Count) then
  1573. begin
  1574. InputError('Segment name index in SI(<segment name>) fixup frame is out of range');
  1575. exit;
  1576. end;
  1577. ffmGroupIndex:
  1578. if (Fixup.FrameDatum<1) or (Fixup.FrameDatum>objdata.GroupsList.Count) then
  1579. begin
  1580. InputError('Group name index in GI(<group name>) fixup frame is out of range');
  1581. exit;
  1582. end;
  1583. ffmExternalIndex:
  1584. if (Fixup.TargetDatum<1) or (Fixup.TargetDatum>ExtDefs.Count) then
  1585. begin
  1586. InputError('External symbol name index in EI(<symbol name>) fixup frame is out of range');
  1587. exit;
  1588. end;
  1589. end;
  1590. if Fixup.TargetMethod in [ftmExternalIndex,ftmExternalIndexNoDisp] then
  1591. begin
  1592. sym:=objdata.symbolref(TOmfExternalNameElement(ExtDefs[Fixup.TargetDatum-1]).Name);
  1593. RelocType:=RELOC_NONE;
  1594. case Fixup.LocationType of
  1595. fltOffset:
  1596. case Fixup.Mode of
  1597. fmSegmentRelative:
  1598. RelocType:=RELOC_ABSOLUTE16;
  1599. fmSelfRelative:
  1600. RelocType:=RELOC_RELATIVE16;
  1601. end;
  1602. fltOffset32:
  1603. case Fixup.Mode of
  1604. fmSegmentRelative:
  1605. RelocType:=RELOC_ABSOLUTE32;
  1606. fmSelfRelative:
  1607. RelocType:=RELOC_RELATIVE32;
  1608. end;
  1609. fltBase:
  1610. case Fixup.Mode of
  1611. fmSegmentRelative:
  1612. RelocType:=RELOC_SEG;
  1613. fmSelfRelative:
  1614. RelocType:=RELOC_SEGREL;
  1615. end;
  1616. fltFarPointer:
  1617. case Fixup.Mode of
  1618. fmSegmentRelative:
  1619. RelocType:=RELOC_FARPTR;
  1620. fmSelfRelative:
  1621. RelocType:=RELOC_FARPTR_RELATIVEOFFSET;
  1622. end;
  1623. fltFarPointer48:
  1624. case Fixup.Mode of
  1625. fmSegmentRelative:
  1626. RelocType:=RELOC_FARPTR48;
  1627. fmSelfRelative:
  1628. RelocType:=RELOC_FARPTR48_RELATIVEOFFSET;
  1629. end;
  1630. end;
  1631. if RelocType=RELOC_NONE then
  1632. begin
  1633. InputError('Unsupported fixup location type '+tostr(Ord(Fixup.LocationType))+' with mode '+tostr(ord(Fixup.Mode))+' in external reference to '+sym.Name);
  1634. exit;
  1635. end;
  1636. reloc:=TOmfRelocation.CreateSymbol(Fixup.LocationOffset,sym,RelocType);
  1637. objsec.ObjRelocations.Add(reloc);
  1638. case Fixup.FrameMethod of
  1639. ffmTarget:
  1640. {nothing};
  1641. ffmGroupIndex:
  1642. reloc.FrameGroup:=TObjSectionGroup(objdata.GroupsList[Fixup.FrameDatum-1]).Name;
  1643. else
  1644. begin
  1645. InputError('Unsupported frame method '+IntToStr(Ord(Fixup.FrameMethod))+' in external reference to '+sym.Name);
  1646. exit;
  1647. end;
  1648. end;
  1649. if Fixup.TargetDisplacement<>0 then
  1650. begin
  1651. InputError('Unsupported nonzero target displacement '+IntToStr(Fixup.TargetDisplacement)+' in external reference to '+sym.Name);
  1652. exit;
  1653. end;
  1654. end
  1655. else if Fixup.TargetMethod in [ftmSegmentIndex,ftmSegmentIndexNoDisp] then
  1656. begin
  1657. target_section:=TOmfObjSection(objdata.ObjSectionList[Fixup.TargetDatum-1]);
  1658. RelocType:=RELOC_NONE;
  1659. case Fixup.LocationType of
  1660. fltOffset:
  1661. case Fixup.Mode of
  1662. fmSegmentRelative:
  1663. RelocType:=RELOC_ABSOLUTE16;
  1664. fmSelfRelative:
  1665. RelocType:=RELOC_RELATIVE16;
  1666. end;
  1667. fltOffset32:
  1668. case Fixup.Mode of
  1669. fmSegmentRelative:
  1670. RelocType:=RELOC_ABSOLUTE32;
  1671. fmSelfRelative:
  1672. RelocType:=RELOC_RELATIVE32;
  1673. end;
  1674. fltBase:
  1675. case Fixup.Mode of
  1676. fmSegmentRelative:
  1677. RelocType:=RELOC_SEG;
  1678. fmSelfRelative:
  1679. RelocType:=RELOC_SEGREL;
  1680. end;
  1681. fltFarPointer:
  1682. case Fixup.Mode of
  1683. fmSegmentRelative:
  1684. RelocType:=RELOC_FARPTR;
  1685. fmSelfRelative:
  1686. RelocType:=RELOC_FARPTR_RELATIVEOFFSET;
  1687. end;
  1688. fltFarPointer48:
  1689. case Fixup.Mode of
  1690. fmSegmentRelative:
  1691. RelocType:=RELOC_FARPTR48;
  1692. fmSelfRelative:
  1693. RelocType:=RELOC_FARPTR48_RELATIVEOFFSET;
  1694. end;
  1695. end;
  1696. if RelocType=RELOC_NONE then
  1697. begin
  1698. InputError('Unsupported fixup location type '+tostr(Ord(Fixup.LocationType))+' with mode '+tostr(ord(Fixup.Mode)));
  1699. exit;
  1700. end;
  1701. reloc:=TOmfRelocation.CreateSection(Fixup.LocationOffset,target_section,RelocType);
  1702. objsec.ObjRelocations.Add(reloc);
  1703. case Fixup.FrameMethod of
  1704. ffmTarget:
  1705. {nothing};
  1706. ffmGroupIndex:
  1707. reloc.FrameGroup:=TObjSectionGroup(objdata.GroupsList[Fixup.FrameDatum-1]).Name;
  1708. else
  1709. begin
  1710. InputError('Unsupported frame method '+IntToStr(Ord(Fixup.FrameMethod))+' in reference to segment '+target_section.Name);
  1711. exit;
  1712. end;
  1713. end;
  1714. if Fixup.TargetDisplacement<>0 then
  1715. begin
  1716. InputError('Unsupported nonzero target displacement '+IntToStr(Fixup.TargetDisplacement)+' in reference to segment '+target_section.Name);
  1717. exit;
  1718. end;
  1719. end
  1720. else if Fixup.TargetMethod in [ftmGroupIndex,ftmGroupIndexNoDisp] then
  1721. begin
  1722. target_group:=TObjSectionGroup(objdata.GroupsList[Fixup.TargetDatum-1]);
  1723. RelocType:=RELOC_NONE;
  1724. case Fixup.LocationType of
  1725. fltOffset:
  1726. case Fixup.Mode of
  1727. fmSegmentRelative:
  1728. RelocType:=RELOC_ABSOLUTE16;
  1729. fmSelfRelative:
  1730. RelocType:=RELOC_RELATIVE16;
  1731. end;
  1732. fltOffset32:
  1733. case Fixup.Mode of
  1734. fmSegmentRelative:
  1735. RelocType:=RELOC_ABSOLUTE32;
  1736. fmSelfRelative:
  1737. RelocType:=RELOC_RELATIVE32;
  1738. end;
  1739. fltBase:
  1740. case Fixup.Mode of
  1741. fmSegmentRelative:
  1742. RelocType:=RELOC_SEG;
  1743. fmSelfRelative:
  1744. RelocType:=RELOC_SEGREL;
  1745. end;
  1746. fltFarPointer:
  1747. case Fixup.Mode of
  1748. fmSegmentRelative:
  1749. RelocType:=RELOC_FARPTR;
  1750. fmSelfRelative:
  1751. RelocType:=RELOC_FARPTR_RELATIVEOFFSET;
  1752. end;
  1753. fltFarPointer48:
  1754. case Fixup.Mode of
  1755. fmSegmentRelative:
  1756. RelocType:=RELOC_FARPTR48;
  1757. fmSelfRelative:
  1758. RelocType:=RELOC_FARPTR48_RELATIVEOFFSET;
  1759. end;
  1760. end;
  1761. if RelocType=RELOC_NONE then
  1762. begin
  1763. InputError('Unsupported fixup location type '+tostr(Ord(Fixup.LocationType))+' with mode '+tostr(ord(Fixup.Mode)));
  1764. exit;
  1765. end;
  1766. reloc:=TOmfRelocation.CreateGroup(Fixup.LocationOffset,target_group,RelocType);
  1767. objsec.ObjRelocations.Add(reloc);
  1768. case Fixup.FrameMethod of
  1769. ffmTarget:
  1770. {nothing};
  1771. else
  1772. begin
  1773. InputError('Unsupported frame method '+IntToStr(Ord(Fixup.FrameMethod))+' in reference to group '+target_group.Name);
  1774. exit;
  1775. end;
  1776. end;
  1777. if Fixup.TargetDisplacement<>0 then
  1778. begin
  1779. InputError('Unsupported nonzero target displacement '+IntToStr(Fixup.TargetDisplacement)+' in reference to group '+target_group.Name);
  1780. exit;
  1781. end;
  1782. end
  1783. else
  1784. begin
  1785. {todo: convert other fixup types as well }
  1786. InputError('Unsupported fixup target method '+IntToStr(Ord(Fixup.TargetMethod)));
  1787. exit;
  1788. end;
  1789. Result:=True;
  1790. end;
  1791. constructor TOmfObjInput.create;
  1792. begin
  1793. inherited create;
  1794. cobjdata:=TOmfObjData;
  1795. FLNames:=TOmfOrderedNameCollection.Create(True);
  1796. FExtDefs:=TFPHashObjectList.Create;
  1797. FPubDefs:=TFPHashObjectList.Create;
  1798. FFixupThreads:=TOmfThreads.Create;
  1799. FRawRecord:=TOmfRawRecord.Create;
  1800. CaseSensitiveSegments:=False;
  1801. CaseSensitiveSymbols:=True;
  1802. end;
  1803. destructor TOmfObjInput.destroy;
  1804. begin
  1805. FRawRecord.Free;
  1806. FFixupThreads.Free;
  1807. FPubDefs.Free;
  1808. FExtDefs.Free;
  1809. FLNames.Free;
  1810. inherited destroy;
  1811. end;
  1812. class function TOmfObjInput.CanReadObjData(AReader: TObjectreader): boolean;
  1813. var
  1814. b: Byte;
  1815. begin
  1816. result:=false;
  1817. if AReader.Read(b,sizeof(b)) then
  1818. begin
  1819. if b=RT_THEADR then
  1820. { TODO: check additional fields }
  1821. result:=true;
  1822. end;
  1823. AReader.Seek(0);
  1824. end;
  1825. function TOmfObjInput.ReadObjData(AReader: TObjectreader; out objdata: TObjData): boolean;
  1826. begin
  1827. FReader:=AReader;
  1828. InputFileName:=AReader.FileName;
  1829. objdata:=CObjData.Create(InputFileName);
  1830. result:=false;
  1831. LNames.Clear;
  1832. ExtDefs.Clear;
  1833. FRawRecord.ReadFrom(FReader);
  1834. if not FRawRecord.VerifyChecksumByte then
  1835. begin
  1836. InputError('Invalid checksum in OMF record');
  1837. exit;
  1838. end;
  1839. if FRawRecord.RecordType<>RT_THEADR then
  1840. begin
  1841. InputError('Can''t read OMF header');
  1842. exit;
  1843. end;
  1844. repeat
  1845. FRawRecord.ReadFrom(FReader);
  1846. if not FRawRecord.VerifyChecksumByte then
  1847. begin
  1848. InputError('Invalid checksum in OMF record');
  1849. exit;
  1850. end;
  1851. case FRawRecord.RecordType of
  1852. RT_LNAMES:
  1853. if not ReadLNames(FRawRecord) then
  1854. exit;
  1855. RT_SEGDEF,RT_SEGDEF32:
  1856. if not ReadSegDef(FRawRecord,objdata) then
  1857. exit;
  1858. RT_GRPDEF:
  1859. if not ReadGrpDef(FRawRecord,objdata) then
  1860. exit;
  1861. RT_COMENT:
  1862. begin
  1863. {todo}
  1864. end;
  1865. RT_EXTDEF:
  1866. if not ReadExtDef(FRawRecord,objdata) then
  1867. exit;
  1868. RT_LPUBDEF,RT_LPUBDEF32,
  1869. RT_PUBDEF,RT_PUBDEF32:
  1870. if not ReadPubDef(FRawRecord,objdata) then
  1871. exit;
  1872. RT_LEDATA,RT_LEDATA32,
  1873. RT_LIDATA,RT_LIDATA32,
  1874. RT_FIXUPP,RT_FIXUPP32:
  1875. if not ReadLeOrLiDataAndFixups(FRawRecord,objdata) then
  1876. exit;
  1877. RT_MODEND,RT_MODEND32:
  1878. if not ReadModEnd(FRawRecord,objdata) then
  1879. exit;
  1880. RT_LINNUM,RT_LINNUM32:
  1881. ;
  1882. else
  1883. begin
  1884. InputError('Unsupported OMF record type $'+HexStr(FRawRecord.RecordType,2));
  1885. exit;
  1886. end;
  1887. end;
  1888. until FRawRecord.RecordType in [RT_MODEND,RT_MODEND32];
  1889. result:=true;
  1890. end;
  1891. {****************************************************************************
  1892. TMZExeHeader
  1893. ****************************************************************************}
  1894. procedure TMZExeHeader.SetHeaderSizeAlignment(AValue: Integer);
  1895. begin
  1896. if (AValue<16) or ((AValue mod 16) <> 0) then
  1897. Internalerror(2015060601);
  1898. FHeaderSizeAlignment:=AValue;
  1899. end;
  1900. constructor TMZExeHeader.Create;
  1901. begin
  1902. FHeaderSizeAlignment:=16;
  1903. end;
  1904. procedure TMZExeHeader.WriteTo(aWriter: TObjectWriter);
  1905. var
  1906. NumRelocs: Word;
  1907. HeaderSizeInBytes: DWord;
  1908. HeaderParagraphs: Word;
  1909. RelocTableOffset: Word;
  1910. BytesInLastBlock: Word;
  1911. BlocksInFile: Word;
  1912. HeaderBytes: array [0..$1B] of Byte;
  1913. RelocBytes: array [0..3] of Byte;
  1914. TotalExeSize: DWord;
  1915. i: Integer;
  1916. begin
  1917. NumRelocs:=Length(Relocations);
  1918. RelocTableOffset:=$1C+Length(ExtraHeaderData);
  1919. HeaderSizeInBytes:=Align(RelocTableOffset+4*NumRelocs,16);
  1920. HeaderParagraphs:=HeaderSizeInBytes div 16;
  1921. TotalExeSize:=HeaderSizeInBytes+LoadableImageSize;
  1922. BlocksInFile:=(TotalExeSize+511) div 512;
  1923. BytesInLastBlock:=TotalExeSize mod 512;
  1924. HeaderBytes[$00]:=$4D; { 'M' }
  1925. HeaderBytes[$01]:=$5A; { 'Z' }
  1926. HeaderBytes[$02]:=Byte(BytesInLastBlock);
  1927. HeaderBytes[$03]:=Byte(BytesInLastBlock shr 8);
  1928. HeaderBytes[$04]:=Byte(BlocksInFile);
  1929. HeaderBytes[$05]:=Byte(BlocksInFile shr 8);
  1930. HeaderBytes[$06]:=Byte(NumRelocs);
  1931. HeaderBytes[$07]:=Byte(NumRelocs shr 8);
  1932. HeaderBytes[$08]:=Byte(HeaderParagraphs);
  1933. HeaderBytes[$09]:=Byte(HeaderParagraphs shr 8);
  1934. HeaderBytes[$0A]:=Byte(MinExtraParagraphs);
  1935. HeaderBytes[$0B]:=Byte(MinExtraParagraphs shr 8);
  1936. HeaderBytes[$0C]:=Byte(MaxExtraParagraphs);
  1937. HeaderBytes[$0D]:=Byte(MaxExtraParagraphs shr 8);
  1938. HeaderBytes[$0E]:=Byte(InitialSS);
  1939. HeaderBytes[$0F]:=Byte(InitialSS shr 8);
  1940. HeaderBytes[$10]:=Byte(InitialSP);
  1941. HeaderBytes[$11]:=Byte(InitialSP shr 8);
  1942. HeaderBytes[$12]:=Byte(Checksum);
  1943. HeaderBytes[$13]:=Byte(Checksum shr 8);
  1944. HeaderBytes[$14]:=Byte(InitialIP);
  1945. HeaderBytes[$15]:=Byte(InitialIP shr 8);
  1946. HeaderBytes[$16]:=Byte(InitialCS);
  1947. HeaderBytes[$17]:=Byte(InitialCS shr 8);
  1948. HeaderBytes[$18]:=Byte(RelocTableOffset);
  1949. HeaderBytes[$19]:=Byte(RelocTableOffset shr 8);
  1950. HeaderBytes[$1A]:=Byte(OverlayNumber);
  1951. HeaderBytes[$1B]:=Byte(OverlayNumber shr 8);
  1952. aWriter.write(HeaderBytes[0],$1C);
  1953. aWriter.write(ExtraHeaderData[0],Length(ExtraHeaderData));
  1954. for i:=0 to NumRelocs-1 do
  1955. with Relocations[i] do
  1956. begin
  1957. RelocBytes[0]:=Byte(offset);
  1958. RelocBytes[1]:=Byte(offset shr 8);
  1959. RelocBytes[2]:=Byte(segment);
  1960. RelocBytes[3]:=Byte(segment shr 8);
  1961. aWriter.write(RelocBytes[0],4);
  1962. end;
  1963. { pad with zeros until the end of header (paragraph aligned) }
  1964. aWriter.WriteZeros(HeaderSizeInBytes-aWriter.Size);
  1965. end;
  1966. procedure TMZExeHeader.AddRelocation(aSegment, aOffset: Word);
  1967. begin
  1968. SetLength(FRelocations,Length(FRelocations)+1);
  1969. with FRelocations[High(FRelocations)] do
  1970. begin
  1971. segment:=aSegment;
  1972. offset:=aOffset;
  1973. end;
  1974. end;
  1975. {****************************************************************************
  1976. TMZExeSection
  1977. ****************************************************************************}
  1978. procedure TMZExeSection.AddObjSection(objsec: TObjSection; ignoreprops: boolean);
  1979. begin
  1980. { allow mixing initialized and uninitialized data in the same section
  1981. => set ignoreprops=true }
  1982. inherited AddObjSection(objsec,true);
  1983. end;
  1984. {****************************************************************************
  1985. TMZExeUnifiedLogicalSegment
  1986. ****************************************************************************}
  1987. constructor TMZExeUnifiedLogicalSegment.create(HashObjectList: TFPHashObjectList; const s: TSymStr);
  1988. var
  1989. Separator: SizeInt;
  1990. begin
  1991. inherited create(HashObjectList,s);
  1992. FObjSectionList:=TFPObjectList.Create(false);
  1993. { name format is 'SegName||ClassName' }
  1994. Separator:=Pos('||',s);
  1995. if Separator>0 then
  1996. begin
  1997. FSegName:=Copy(s,1,Separator-1);
  1998. FSegClass:=Copy(s,Separator+2,Length(s)-Separator-1);
  1999. end
  2000. else
  2001. begin
  2002. FSegName:=Name;
  2003. FSegClass:='';
  2004. end;
  2005. { wlink recognizes the stack segment by the class name 'STACK' }
  2006. { let's be compatible with wlink }
  2007. IsStack:=FSegClass='STACK';
  2008. end;
  2009. destructor TMZExeUnifiedLogicalSegment.destroy;
  2010. begin
  2011. FObjSectionList.Free;
  2012. inherited destroy;
  2013. end;
  2014. procedure TMZExeUnifiedLogicalSegment.AddObjSection(ObjSec: TOmfObjSection);
  2015. begin
  2016. ObjSectionList.Add(ObjSec);
  2017. ObjSec.MZExeUnifiedLogicalSegment:=self;
  2018. { tlink (and ms link?) use the scStack segment combination to recognize
  2019. the stack segment.
  2020. let's be compatible with tlink as well }
  2021. if ObjSec.Combination=scStack then
  2022. IsStack:=True;
  2023. end;
  2024. procedure TMZExeUnifiedLogicalSegment.CalcMemPos;
  2025. var
  2026. MinMemPos: qword=high(qword);
  2027. MaxMemPos: qword=0;
  2028. objsec: TOmfObjSection;
  2029. i: Integer;
  2030. begin
  2031. if ObjSectionList.Count=0 then
  2032. internalerror(2015082201);
  2033. for i:=0 to ObjSectionList.Count-1 do
  2034. begin
  2035. objsec:=TOmfObjSection(ObjSectionList[i]);
  2036. if objsec.MemPos<MinMemPos then
  2037. MinMemPos:=objsec.MemPos;
  2038. if (objsec.MemPos+objsec.Size)>MaxMemPos then
  2039. MaxMemPos:=objsec.MemPos+objsec.Size;
  2040. end;
  2041. MemPos:=MinMemPos;
  2042. Size:=MaxMemPos-MemPos;
  2043. end;
  2044. function TMZExeUnifiedLogicalSegment.MemPosStr: string;
  2045. begin
  2046. Result:=HexStr(MemBasePos shr 4,4)+':'+HexStr((MemPos-MemBasePos),4);
  2047. end;
  2048. {****************************************************************************
  2049. TMZExeUnifiedLogicalGroup
  2050. ****************************************************************************}
  2051. constructor TMZExeUnifiedLogicalGroup.create(HashObjectList: TFPHashObjectList; const s: TSymStr);
  2052. begin
  2053. inherited create(HashObjectList,s);
  2054. FSegmentList:=TFPHashObjectList.Create(false);
  2055. end;
  2056. destructor TMZExeUnifiedLogicalGroup.destroy;
  2057. begin
  2058. FSegmentList.Free;
  2059. inherited destroy;
  2060. end;
  2061. procedure TMZExeUnifiedLogicalGroup.CalcMemPos;
  2062. var
  2063. MinMemPos: qword=high(qword);
  2064. MaxMemPos: qword=0;
  2065. UniSeg: TMZExeUnifiedLogicalSegment;
  2066. i: Integer;
  2067. begin
  2068. if SegmentList.Count=0 then
  2069. internalerror(2015082201);
  2070. for i:=0 to SegmentList.Count-1 do
  2071. begin
  2072. UniSeg:=TMZExeUnifiedLogicalSegment(SegmentList[i]);
  2073. if UniSeg.MemPos<MinMemPos then
  2074. MinMemPos:=UniSeg.MemPos;
  2075. if (UniSeg.MemPos+UniSeg.Size)>MaxMemPos then
  2076. MaxMemPos:=UniSeg.MemPos+UniSeg.Size;
  2077. end;
  2078. { align *down* on a paragraph boundary }
  2079. MemPos:=(MinMemPos shr 4) shl 4;
  2080. Size:=MaxMemPos-MemPos;
  2081. end;
  2082. function TMZExeUnifiedLogicalGroup.MemPosStr: string;
  2083. begin
  2084. Result:=HexStr(MemPos shr 4,4)+':'+HexStr(MemPos and $f,4);
  2085. end;
  2086. procedure TMZExeUnifiedLogicalGroup.AddSegment(UniSeg: TMZExeUnifiedLogicalSegment);
  2087. begin
  2088. SegmentList.Add(UniSeg.Name,UniSeg);
  2089. if UniSeg.PrimaryGroup='' then
  2090. UniSeg.PrimaryGroup:=Name;
  2091. end;
  2092. {****************************************************************************
  2093. TMZExeOutput
  2094. ****************************************************************************}
  2095. function TMZExeOutput.GetMZFlatContentSection: TMZExeSection;
  2096. begin
  2097. if not assigned(FMZFlatContentSection) then
  2098. FMZFlatContentSection:=TMZExeSection(FindExeSection('.MZ_flat_content'));
  2099. result:=FMZFlatContentSection;
  2100. end;
  2101. procedure TMZExeOutput.CalcExeUnifiedLogicalSegments;
  2102. var
  2103. ExeSec: TMZExeSection;
  2104. ObjSec: TOmfObjSection;
  2105. UniSeg: TMZExeUnifiedLogicalSegment;
  2106. i: Integer;
  2107. begin
  2108. ExeSec:=MZFlatContentSection;
  2109. for i:=0 to ExeSec.ObjSectionList.Count-1 do
  2110. begin
  2111. ObjSec:=TOmfObjSection(ExeSec.ObjSectionList[i]);
  2112. UniSeg:=TMZExeUnifiedLogicalSegment(ExeUnifiedLogicalSegments.Find(ObjSec.Name));
  2113. if not assigned(UniSeg) then
  2114. UniSeg:=TMZExeUnifiedLogicalSegment.Create(ExeUnifiedLogicalSegments,ObjSec.Name);
  2115. UniSeg.AddObjSection(ObjSec);
  2116. end;
  2117. for i:=0 to ExeUnifiedLogicalSegments.Count-1 do
  2118. begin
  2119. UniSeg:=TMZExeUnifiedLogicalSegment(ExeUnifiedLogicalSegments[i]);
  2120. UniSeg.CalcMemPos;
  2121. if UniSeg.Size>$10000 then
  2122. begin
  2123. if current_settings.x86memorymodel=mm_tiny then
  2124. Message1(link_e_program_segment_too_large,IntToStr(UniSeg.Size-$10000))
  2125. else if UniSeg.SegClass='CODE' then
  2126. Message2(link_e_code_segment_too_large,UniSeg.SegName,IntToStr(UniSeg.Size-$10000))
  2127. else if UniSeg.SegClass='DATA' then
  2128. Message2(link_e_data_segment_too_large,UniSeg.SegName,IntToStr(UniSeg.Size-$10000))
  2129. else
  2130. Message2(link_e_segment_too_large,UniSeg.SegName,IntToStr(UniSeg.Size-$10000)+' '+UniSeg.SegName);
  2131. end;
  2132. end;
  2133. end;
  2134. procedure TMZExeOutput.CalcExeGroups;
  2135. procedure AddToGroup(UniSeg:TMZExeUnifiedLogicalSegment;GroupName:TSymStr);
  2136. var
  2137. Group: TMZExeUnifiedLogicalGroup;
  2138. begin
  2139. Group:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups.Find(GroupName));
  2140. if not assigned(Group) then
  2141. Group:=TMZExeUnifiedLogicalGroup.Create(ExeUnifiedLogicalGroups,GroupName);
  2142. Group.AddSegment(UniSeg);
  2143. end;
  2144. var
  2145. objdataidx,groupidx,secidx: Integer;
  2146. ObjData: TObjData;
  2147. ObjGroup: TObjSectionGroup;
  2148. ObjSec: TOmfObjSection;
  2149. UniGrp: TMZExeUnifiedLogicalGroup;
  2150. begin
  2151. for objdataidx:=0 to ObjDataList.Count-1 do
  2152. begin
  2153. ObjData:=TObjData(ObjDataList[objdataidx]);
  2154. if assigned(ObjData.GroupsList) then
  2155. for groupidx:=0 to ObjData.GroupsList.Count-1 do
  2156. begin
  2157. ObjGroup:=TObjSectionGroup(ObjData.GroupsList[groupidx]);
  2158. for secidx:=low(ObjGroup.members) to high(ObjGroup.members) do
  2159. begin
  2160. ObjSec:=TOmfObjSection(ObjGroup.members[secidx]);
  2161. if assigned(ObjSec.MZExeUnifiedLogicalSegment) then
  2162. AddToGroup(ObjSec.MZExeUnifiedLogicalSegment,ObjGroup.Name);
  2163. end;
  2164. end;
  2165. end;
  2166. for groupidx:=0 to ExeUnifiedLogicalGroups.Count-1 do
  2167. begin
  2168. UniGrp:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups[groupidx]);
  2169. UniGrp.CalcMemPos;
  2170. if UniGrp.Size>$10000 then
  2171. begin
  2172. if current_settings.x86memorymodel=mm_tiny then
  2173. Message1(link_e_program_segment_too_large,IntToStr(UniGrp.Size-$10000))
  2174. else if UniGrp.Name='DGROUP' then
  2175. Message2(link_e_data_segment_too_large,UniGrp.Name,IntToStr(UniGrp.Size-$10000))
  2176. else
  2177. Message2(link_e_group_too_large,UniGrp.Name,IntToStr(UniGrp.Size-$10000));
  2178. end;
  2179. end;
  2180. end;
  2181. procedure TMZExeOutput.CalcSegments_MemBasePos;
  2182. var
  2183. lastbase:qword=0;
  2184. i: Integer;
  2185. UniSeg: TMZExeUnifiedLogicalSegment;
  2186. begin
  2187. for i:=0 to ExeUnifiedLogicalSegments.Count-1 do
  2188. begin
  2189. UniSeg:=TMZExeUnifiedLogicalSegment(ExeUnifiedLogicalSegments[i]);
  2190. if (UniSeg.PrimaryGroup<>'') or (UniSeg.IsStack) or
  2191. (((UniSeg.MemPos+UniSeg.Size-1)-lastbase)>$ffff) then
  2192. lastbase:=(UniSeg.MemPos shr 4) shl 4;
  2193. UniSeg.MemBasePos:=lastbase;
  2194. end;
  2195. end;
  2196. procedure TMZExeOutput.WriteMap_SegmentsAndGroups;
  2197. var
  2198. i: Integer;
  2199. UniSeg: TMZExeUnifiedLogicalSegment;
  2200. UniGrp: TMZExeUnifiedLogicalGroup;
  2201. begin
  2202. exemap.AddHeader('Groups list');
  2203. exemap.Add('');
  2204. exemap.Add(PadSpace('Group',32)+PadSpace('Address',21)+'Size');
  2205. exemap.Add(PadSpace('=====',32)+PadSpace('=======',21)+'====');
  2206. exemap.Add('');
  2207. for i:=0 to ExeUnifiedLogicalGroups.Count-1 do
  2208. begin
  2209. UniGrp:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups[i]);
  2210. exemap.Add(PadSpace(UniGrp.Name,32)+PadSpace(UniGrp.MemPosStr,21)+HexStr(UniGrp.Size,8));
  2211. end;
  2212. exemap.Add('');
  2213. exemap.AddHeader('Segments list');
  2214. exemap.Add('');
  2215. exemap.Add(PadSpace('Segment',23)+PadSpace('Class',15)+PadSpace('Group',15)+PadSpace('Address',16)+'Size');
  2216. exemap.Add(PadSpace('=======',23)+PadSpace('=====',15)+PadSpace('=====',15)+PadSpace('=======',16)+'====');
  2217. exemap.Add('');
  2218. for i:=0 to ExeUnifiedLogicalSegments.Count-1 do
  2219. begin
  2220. UniSeg:=TMZExeUnifiedLogicalSegment(ExeUnifiedLogicalSegments[i]);
  2221. exemap.Add(PadSpace(UniSeg.SegName,23)+PadSpace(UniSeg.SegClass,15)+PadSpace(UniSeg.PrimaryGroup,15)+PadSpace(UniSeg.MemPosStr,16)+HexStr(UniSeg.Size,8));
  2222. end;
  2223. exemap.Add('');
  2224. end;
  2225. procedure TMZExeOutput.WriteMap_HeaderData;
  2226. begin
  2227. exemap.AddHeader('Header data');
  2228. exemap.Add('Loadable image size: '+HexStr(Header.LoadableImageSize,8));
  2229. exemap.Add('Min extra paragraphs: '+HexStr(Header.MinExtraParagraphs,4));
  2230. exemap.Add('Max extra paragraphs: '+HexStr(Header.MaxExtraParagraphs,4));
  2231. exemap.Add('Initial stack pointer: '+HexStr(Header.InitialSS,4)+':'+HexStr(Header.InitialSP,4));
  2232. exemap.Add('Entry point address: '+HexStr(Header.InitialCS,4)+':'+HexStr(Header.InitialIP,4));
  2233. end;
  2234. function TMZExeOutput.FindStackSegment: TMZExeUnifiedLogicalSegment;
  2235. var
  2236. i: Integer;
  2237. stackseg_wannabe: TMZExeUnifiedLogicalSegment;
  2238. begin
  2239. Result:=nil;
  2240. for i:=0 to ExeUnifiedLogicalSegments.Count-1 do
  2241. begin
  2242. stackseg_wannabe:=TMZExeUnifiedLogicalSegment(ExeUnifiedLogicalSegments[i]);
  2243. { if there are multiple stack segments, choose the largest one.
  2244. In theory, we're probably supposed to combine them all and put
  2245. them in a contiguous location in memory, but we don't care }
  2246. if stackseg_wannabe.IsStack and
  2247. (not assigned(result) or (Result.Size<stackseg_wannabe.Size)) then
  2248. Result:=stackseg_wannabe;
  2249. end;
  2250. end;
  2251. procedure TMZExeOutput.FillLoadableImageSize;
  2252. var
  2253. i: Integer;
  2254. ExeSec: TMZExeSection;
  2255. ObjSec: TOmfObjSection;
  2256. StartDataPos: LongWord;
  2257. buf: array [0..1023] of byte;
  2258. bytesread: LongWord;
  2259. begin
  2260. Header.LoadableImageSize:=0;
  2261. ExeSec:=MZFlatContentSection;
  2262. for i:=0 to ExeSec.ObjSectionList.Count-1 do
  2263. begin
  2264. ObjSec:=TOmfObjSection(ExeSec.ObjSectionList[i]);
  2265. if (ObjSec.Size>0) and assigned(ObjSec.Data) then
  2266. if (ObjSec.MemPos+ObjSec.Size)>Header.LoadableImageSize then
  2267. Header.LoadableImageSize:=ObjSec.MemPos+ObjSec.Size;
  2268. end;
  2269. end;
  2270. procedure TMZExeOutput.FillMinExtraParagraphs;
  2271. var
  2272. ExeSec: TMZExeSection;
  2273. begin
  2274. ExeSec:=MZFlatContentSection;
  2275. Header.MinExtraParagraphs:=(align(ExeSec.Size,16)-align(Header.LoadableImageSize,16)) div 16;
  2276. end;
  2277. procedure TMZExeOutput.FillMaxExtraParagraphs;
  2278. var
  2279. heapmin_paragraphs: Integer;
  2280. heapmax_paragraphs: Integer;
  2281. begin
  2282. if current_settings.x86memorymodel in x86_far_data_models then
  2283. begin
  2284. { calculate the additional number of paragraphs needed }
  2285. heapmin_paragraphs:=(heapsize + 15) div 16;
  2286. heapmax_paragraphs:=(maxheapsize + 15) div 16;
  2287. Header.MaxExtraParagraphs:=min(Header.MinExtraParagraphs-heapmin_paragraphs+heapmax_paragraphs,$FFFF);
  2288. end
  2289. else
  2290. Header.MaxExtraParagraphs:=$FFFF;
  2291. end;
  2292. procedure TMZExeOutput.FillStartAddress;
  2293. var
  2294. EntryMemPos: qword;
  2295. EntryMemBasePos: qword;
  2296. begin
  2297. EntryMemPos:=EntrySym.address;
  2298. if assigned(EntrySym.group) then
  2299. EntryMemBasePos:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups.Find(EntrySym.group.Name)).MemPos
  2300. else
  2301. EntryMemBasePos:=TOmfObjSection(EntrySym.objsection).MZExeUnifiedLogicalSegment.MemBasePos;
  2302. Header.InitialIP:=EntryMemPos-EntryMemBasePos;
  2303. Header.InitialCS:=EntryMemBasePos shr 4;
  2304. end;
  2305. procedure TMZExeOutput.FillStackAddress;
  2306. var
  2307. stackseg: TMZExeUnifiedLogicalSegment;
  2308. begin
  2309. stackseg:=FindStackSegment;
  2310. if assigned(stackseg) then
  2311. begin
  2312. Header.InitialSS:=stackseg.MemBasePos shr 4;
  2313. Header.InitialSP:=stackseg.MemPos+stackseg.Size-stackseg.MemBasePos;
  2314. end
  2315. else
  2316. begin
  2317. Header.InitialSS:=0;
  2318. Header.InitialSP:=0;
  2319. end;
  2320. end;
  2321. procedure TMZExeOutput.FillHeaderData;
  2322. begin
  2323. Header.MaxExtraParagraphs:=$FFFF;
  2324. FillLoadableImageSize;
  2325. FillMinExtraParagraphs;
  2326. FillMaxExtraParagraphs;
  2327. FillStartAddress;
  2328. FillStackAddress;
  2329. if assigned(exemap) then
  2330. WriteMap_HeaderData;
  2331. end;
  2332. function TMZExeOutput.writeExe: boolean;
  2333. var
  2334. ExeSec: TMZExeSection;
  2335. i: Integer;
  2336. ObjSec: TOmfObjSection;
  2337. begin
  2338. Result:=False;
  2339. FillHeaderData;
  2340. Header.WriteTo(FWriter);
  2341. ExeSec:=MZFlatContentSection;
  2342. ExeSec.DataPos:=FWriter.Size;
  2343. for i:=0 to ExeSec.ObjSectionList.Count-1 do
  2344. begin
  2345. ObjSec:=TOmfObjSection(ExeSec.ObjSectionList[i]);
  2346. if ObjSec.MemPos<Header.LoadableImageSize then
  2347. begin
  2348. FWriter.WriteZeros(max(0,ObjSec.MemPos-FWriter.Size+ExeSec.DataPos));
  2349. if assigned(ObjSec.Data) then
  2350. FWriter.writearray(ObjSec.Data);
  2351. end;
  2352. end;
  2353. Result:=True;
  2354. end;
  2355. function TMZExeOutput.writeCom: boolean;
  2356. const
  2357. ComFileOffset=$100;
  2358. var
  2359. i: Integer;
  2360. ExeSec: TMZExeSection;
  2361. ObjSec: TOmfObjSection;
  2362. StartDataPos: LongWord;
  2363. buf: array [0..1023] of byte;
  2364. bytesread: LongWord;
  2365. begin
  2366. FillHeaderData;
  2367. if Length(Header.Relocations)>0 then
  2368. begin
  2369. Message(link_e_com_program_uses_segment_relocations);
  2370. exit(False);
  2371. end;
  2372. ExeSec:=MZFlatContentSection;
  2373. for i:=0 to ExeSec.ObjSectionList.Count-1 do
  2374. begin
  2375. ObjSec:=TOmfObjSection(ExeSec.ObjSectionList[i]);
  2376. if ObjSec.MemPos<Header.LoadableImageSize then
  2377. begin
  2378. FWriter.WriteZeros(max(0,ObjSec.MemPos-ComFileOffset-FWriter.Size));
  2379. if assigned(ObjSec.Data) then
  2380. begin
  2381. if ObjSec.MemPos<ComFileOffset then
  2382. begin
  2383. ObjSec.Data.seek(ComFileOffset-ObjSec.MemPos);
  2384. repeat
  2385. bytesread:=ObjSec.Data.read(buf,sizeof(buf));
  2386. if bytesread<>0 then
  2387. FWriter.write(buf,bytesread);
  2388. until bytesread=0;
  2389. end
  2390. else
  2391. FWriter.writearray(ObjSec.Data);
  2392. end;
  2393. end;
  2394. end;
  2395. Result:=True;
  2396. end;
  2397. function TMZExeOutput.writeDebugElf: boolean;
  2398. var
  2399. ElfHeader: TElf32header;
  2400. begin
  2401. FillChar(ElfHeader,SizeOf(ElfHeader),0);
  2402. ElfHeader.e_ident[EI_MAG0]:=ELFMAG0; { = #127'ELF' }
  2403. ElfHeader.e_ident[EI_MAG1]:=ELFMAG1;
  2404. ElfHeader.e_ident[EI_MAG2]:=ELFMAG2;
  2405. ElfHeader.e_ident[EI_MAG3]:=ELFMAG3;
  2406. ElfHeader.e_ident[EI_CLASS]:=ELFCLASS32;
  2407. ElfHeader.e_ident[EI_DATA]:=ELFDATA2LSB;
  2408. ElfHeader.e_ident[EI_VERSION]:=1;
  2409. ElfHeader.e_ident[EI_OSABI]:=ELFOSABI_NONE;
  2410. ElfHeader.e_ident[EI_ABIVERSION]:=0;
  2411. ElfHeader.e_type:=ET_EXEC;
  2412. ElfHeader.e_machine:=EM_386;
  2413. ElfHeader.e_version:=1;
  2414. ElfHeader.e_entry:=0;
  2415. ElfHeader.e_phoff:=0;
  2416. ElfHeader.e_shoff:=SizeOf(ElfHeader);
  2417. ElfHeader.e_flags:=0;
  2418. ElfHeader.e_ehsize:=SizeOf(ElfHeader);
  2419. ElfHeader.e_phentsize:=SizeOf(TElf32proghdr);
  2420. ElfHeader.e_phnum:=0;
  2421. ElfHeader.e_shentsize:=SizeOf(TElf32sechdr);
  2422. ElfHeader.e_shnum:=6;
  2423. ElfHeader.e_shstrndx:=5;
  2424. {todo: implement}
  2425. Result:=True;
  2426. end;
  2427. procedure TMZExeOutput.Load_Symbol(const aname: string);
  2428. var
  2429. dgroup: TObjSectionGroup;
  2430. sym: TObjSymbol;
  2431. begin
  2432. { special handling for the '_edata' and '_end' symbols, which are
  2433. internally added by the linker }
  2434. if (aname='_edata') or (aname='_end') then
  2435. begin
  2436. { create an internal segment with the 'BSS' class }
  2437. internalObjData.createsection('*'+aname+'||BSS',0,[]);
  2438. { add to group 'DGROUP' }
  2439. dgroup:=nil;
  2440. if assigned(internalObjData.GroupsList) then
  2441. dgroup:=TObjSectionGroup(internalObjData.GroupsList.Find('DGROUP'));
  2442. if dgroup=nil then
  2443. dgroup:=internalObjData.createsectiongroup('DGROUP');
  2444. SetLength(dgroup.members,Length(dgroup.members)+1);
  2445. dgroup.members[Length(dgroup.members)-1]:=internalObjData.CurrObjSec;
  2446. { define the symbol itself }
  2447. sym:=internalObjData.SymbolDefine(aname,AB_GLOBAL,AT_DATA);
  2448. sym.group:=dgroup;
  2449. end
  2450. else
  2451. inherited;
  2452. end;
  2453. procedure TMZExeOutput.DoRelocationFixup(objsec: TObjSection);
  2454. var
  2455. i: Integer;
  2456. omfsec: TOmfObjSection absolute objsec;
  2457. objreloc: TOmfRelocation;
  2458. target: DWord;
  2459. framebase: DWord;
  2460. fixupamount: Integer;
  2461. target_group: TMZExeUnifiedLogicalGroup;
  2462. procedure FixupOffset;
  2463. var
  2464. w: Word;
  2465. begin
  2466. omfsec.Data.seek(objreloc.DataOffset);
  2467. omfsec.Data.read(w,2);
  2468. w:=LEtoN(w);
  2469. Inc(w,fixupamount);
  2470. w:=LEtoN(w);
  2471. omfsec.Data.seek(objreloc.DataOffset);
  2472. omfsec.Data.write(w,2);
  2473. end;
  2474. procedure FixupOffset32;
  2475. var
  2476. lw: LongWord;
  2477. begin
  2478. omfsec.Data.seek(objreloc.DataOffset);
  2479. omfsec.Data.read(lw,4);
  2480. lw:=LEtoN(lw);
  2481. Inc(lw,fixupamount);
  2482. lw:=LEtoN(lw);
  2483. omfsec.Data.seek(objreloc.DataOffset);
  2484. omfsec.Data.write(lw,4);
  2485. end;
  2486. procedure FixupBase(DataOffset: LongWord);
  2487. var
  2488. w: Word;
  2489. begin
  2490. omfsec.Data.seek(DataOffset);
  2491. omfsec.Data.read(w,2);
  2492. w:=LEtoN(w);
  2493. Inc(w,framebase shr 4);
  2494. w:=LEtoN(w);
  2495. omfsec.Data.seek(DataOffset);
  2496. omfsec.Data.write(w,2);
  2497. Header.AddRelocation(omfsec.MZExeUnifiedLogicalSegment.MemBasePos shr 4,
  2498. omfsec.MemPos+DataOffset-omfsec.MZExeUnifiedLogicalSegment.MemBasePos);
  2499. end;
  2500. begin
  2501. for i:=0 to objsec.ObjRelocations.Count-1 do
  2502. begin
  2503. objreloc:=TOmfRelocation(objsec.ObjRelocations[i]);
  2504. if assigned(objreloc.symbol) then
  2505. begin
  2506. target:=objreloc.symbol.address;
  2507. if objreloc.FrameGroup<>'' then
  2508. framebase:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups.Find(objreloc.FrameGroup)).MemPos
  2509. else if assigned(objreloc.symbol.group) then
  2510. framebase:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups.Find(objreloc.symbol.group.Name)).MemPos
  2511. else
  2512. framebase:=TOmfObjSection(objreloc.symbol.objsection).MZExeUnifiedLogicalSegment.MemBasePos;
  2513. case objreloc.typ of
  2514. RELOC_ABSOLUTE16,RELOC_ABSOLUTE32,RELOC_SEG,RELOC_FARPTR,RELOC_FARPTR48:
  2515. fixupamount:=target-framebase;
  2516. RELOC_RELATIVE16,RELOC_SEGREL,RELOC_FARPTR_RELATIVEOFFSET:
  2517. fixupamount:=target-(omfsec.MemPos+objreloc.DataOffset)-2;
  2518. RELOC_RELATIVE32,RELOC_FARPTR48_RELATIVEOFFSET:
  2519. fixupamount:=target-(omfsec.MemPos+objreloc.DataOffset)-4;
  2520. else
  2521. internalerror(2015082402);
  2522. end;
  2523. case objreloc.typ of
  2524. RELOC_ABSOLUTE16,
  2525. RELOC_RELATIVE16:
  2526. FixupOffset;
  2527. RELOC_ABSOLUTE32,
  2528. RELOC_RELATIVE32:
  2529. FixupOffset32;
  2530. RELOC_SEG,
  2531. RELOC_SEGREL:
  2532. FixupBase(objreloc.DataOffset);
  2533. RELOC_FARPTR,
  2534. RELOC_FARPTR_RELATIVEOFFSET:
  2535. begin
  2536. FixupOffset;
  2537. FixupBase(objreloc.DataOffset+2);
  2538. end;
  2539. RELOC_FARPTR48,
  2540. RELOC_FARPTR48_RELATIVEOFFSET:
  2541. begin
  2542. FixupOffset32;
  2543. FixupBase(objreloc.DataOffset+4);
  2544. end;
  2545. else
  2546. internalerror(2015082403);
  2547. end;
  2548. end
  2549. else if assigned(objreloc.objsection) then
  2550. begin
  2551. target:=objreloc.objsection.MemPos;
  2552. if objreloc.FrameGroup<>'' then
  2553. framebase:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups.Find(objreloc.FrameGroup)).MemPos
  2554. else
  2555. framebase:=TOmfObjSection(objreloc.objsection).MZExeUnifiedLogicalSegment.MemBasePos;
  2556. case objreloc.typ of
  2557. RELOC_ABSOLUTE16,RELOC_ABSOLUTE32,RELOC_SEG,RELOC_FARPTR,RELOC_FARPTR48:
  2558. fixupamount:=target-framebase;
  2559. RELOC_RELATIVE16,RELOC_SEGREL,RELOC_FARPTR_RELATIVEOFFSET:
  2560. fixupamount:=target-(omfsec.MemPos+objreloc.DataOffset)-2;
  2561. RELOC_RELATIVE32,RELOC_FARPTR48_RELATIVEOFFSET:
  2562. fixupamount:=target-(omfsec.MemPos+objreloc.DataOffset)-4;
  2563. else
  2564. internalerror(2015082405);
  2565. end;
  2566. case objreloc.typ of
  2567. RELOC_ABSOLUTE16,
  2568. RELOC_RELATIVE16:
  2569. FixupOffset;
  2570. RELOC_ABSOLUTE32,
  2571. RELOC_RELATIVE32:
  2572. FixupOffset32;
  2573. RELOC_SEG,
  2574. RELOC_SEGREL:
  2575. FixupBase(objreloc.DataOffset);
  2576. RELOC_FARPTR,
  2577. RELOC_FARPTR_RELATIVEOFFSET:
  2578. begin
  2579. FixupOffset;
  2580. FixupBase(objreloc.DataOffset+2);
  2581. end;
  2582. RELOC_FARPTR48,
  2583. RELOC_FARPTR48_RELATIVEOFFSET:
  2584. begin
  2585. FixupOffset32;
  2586. FixupBase(objreloc.DataOffset+4);
  2587. end;
  2588. else
  2589. internalerror(2015082406);
  2590. end;
  2591. end
  2592. else if assigned(objreloc.group) then
  2593. begin
  2594. target_group:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups.Find(objreloc.group.Name));
  2595. target:=target_group.MemPos;
  2596. if objreloc.FrameGroup<>'' then
  2597. framebase:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups.Find(objreloc.FrameGroup)).MemPos
  2598. else
  2599. framebase:=target_group.MemPos;
  2600. case objreloc.typ of
  2601. RELOC_ABSOLUTE16,RELOC_ABSOLUTE32,RELOC_SEG,RELOC_FARPTR,RELOC_FARPTR48:
  2602. fixupamount:=target-framebase;
  2603. RELOC_RELATIVE16,RELOC_SEGREL,RELOC_FARPTR_RELATIVEOFFSET:
  2604. fixupamount:=target-(omfsec.MemPos+objreloc.DataOffset)-2;
  2605. RELOC_RELATIVE32,RELOC_FARPTR48_RELATIVEOFFSET:
  2606. fixupamount:=target-(omfsec.MemPos+objreloc.DataOffset)-4;
  2607. else
  2608. internalerror(2015111202);
  2609. end;
  2610. case objreloc.typ of
  2611. RELOC_ABSOLUTE16,
  2612. RELOC_RELATIVE16:
  2613. FixupOffset;
  2614. RELOC_ABSOLUTE32,
  2615. RELOC_RELATIVE32:
  2616. FixupOffset32;
  2617. RELOC_SEG,
  2618. RELOC_SEGREL:
  2619. FixupBase(objreloc.DataOffset);
  2620. RELOC_FARPTR,
  2621. RELOC_FARPTR_RELATIVEOFFSET:
  2622. begin
  2623. FixupOffset;
  2624. FixupBase(objreloc.DataOffset+2);
  2625. end;
  2626. RELOC_FARPTR48,
  2627. RELOC_FARPTR48_RELATIVEOFFSET:
  2628. begin
  2629. FixupOffset32;
  2630. FixupBase(objreloc.DataOffset+4);
  2631. end;
  2632. else
  2633. internalerror(2015111203);
  2634. end;
  2635. end
  2636. else
  2637. internalerror(2015082407);
  2638. end;
  2639. end;
  2640. function IOmfObjSectionClassNameCompare(Item1, Item2: Pointer): Integer;
  2641. var
  2642. I1 : TOmfObjSection absolute Item1;
  2643. I2 : TOmfObjSection absolute Item2;
  2644. begin
  2645. Result:=CompareStr(I1.ClassName,I2.ClassName);
  2646. if Result=0 then
  2647. Result:=CompareStr(I1.Name,I2.Name);
  2648. if Result=0 then
  2649. Result:=I1.SortOrder-I2.SortOrder;
  2650. end;
  2651. procedure TMZExeOutput.Order_ObjSectionList(ObjSectionList: TFPObjectList; const aPattern: string);
  2652. var
  2653. i: Integer;
  2654. begin
  2655. for i:=0 to ObjSectionList.Count-1 do
  2656. TOmfObjSection(ObjSectionList[i]).SortOrder:=i;
  2657. ObjSectionList.Sort(@IOmfObjSectionClassNameCompare);
  2658. end;
  2659. procedure TMZExeOutput.MemPos_EndExeSection;
  2660. var
  2661. SecName: TSymStr='';
  2662. begin
  2663. if assigned(CurrExeSec) then
  2664. SecName:=CurrExeSec.Name;
  2665. inherited MemPos_EndExeSection;
  2666. if SecName='.MZ_flat_content' then
  2667. begin
  2668. CalcExeUnifiedLogicalSegments;
  2669. CalcExeGroups;
  2670. CalcSegments_MemBasePos;
  2671. if assigned(exemap) then
  2672. WriteMap_SegmentsAndGroups;
  2673. end;
  2674. end;
  2675. function TMZExeOutput.writeData: boolean;
  2676. begin
  2677. if apptype=app_com then
  2678. Result:=WriteCom
  2679. else
  2680. Result:=WriteExe;
  2681. end;
  2682. constructor TMZExeOutput.create;
  2683. begin
  2684. inherited create;
  2685. CExeSection:=TMZExeSection;
  2686. CObjData:=TOmfObjData;
  2687. CObjSymbol:=TOmfObjSymbol;
  2688. { "640K ought to be enough for anybody" :) }
  2689. MaxMemPos:=$9FFFF;
  2690. FExeUnifiedLogicalSegments:=TFPHashObjectList.Create;
  2691. FExeUnifiedLogicalGroups:=TFPHashObjectList.Create;
  2692. FHeader:=TMZExeHeader.Create;
  2693. end;
  2694. destructor TMZExeOutput.destroy;
  2695. begin
  2696. FHeader.Free;
  2697. FExeUnifiedLogicalGroups.Free;
  2698. FExeUnifiedLogicalSegments.Free;
  2699. inherited destroy;
  2700. end;
  2701. {****************************************************************************
  2702. TOmfAssembler
  2703. ****************************************************************************}
  2704. constructor TOmfAssembler.Create(info: pasminfo; smart:boolean);
  2705. begin
  2706. inherited;
  2707. CObjOutput:=TOmfObjOutput;
  2708. CInternalAr:=TOmfLibObjectWriter;
  2709. end;
  2710. {*****************************************************************************
  2711. Initialize
  2712. *****************************************************************************}
  2713. {$ifdef i8086}
  2714. const
  2715. as_i8086_omf_info : tasminfo =
  2716. (
  2717. id : as_i8086_omf;
  2718. idtxt : 'OMF';
  2719. asmbin : '';
  2720. asmcmd : '';
  2721. supported_targets : [system_i8086_msdos,system_i8086_embedded];
  2722. flags : [af_outputbinary,af_no_debug];
  2723. labelprefix : '..@';
  2724. comment : '; ';
  2725. dollarsign: '$';
  2726. );
  2727. {$endif i8086}
  2728. initialization
  2729. {$ifdef i8086}
  2730. RegisterAssembler(as_i8086_omf_info,TOmfAssembler);
  2731. {$endif i8086}
  2732. end.