ogomf.pas 171 KB

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