ogomf.pas 148 KB

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