2
0

ogomf.pas 187 KB

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