ogomf.pas 181 KB

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