ogomf.pas 187 KB

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