ogomf.pas 183 KB

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