ogomf.pas 105 KB

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