ogomf.pas 164 KB

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