ogomf.pas 105 KB

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