ogomf.pas 108 KB

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