ogomf.pas 109 KB

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