ogomf.pas 183 KB

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