ogomf.pas 148 KB

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