ogomf.pas 126 KB

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