ogomf.pas 123 KB

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