ogomf.pas 124 KB

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