ogomf.pas 138 KB

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