omfbase.pas 55 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542
  1. {
  2. Copyright (c) 2015 by Nikolay Nikolov
  3. Contains Relocatable Object Module Format (OMF) definitions
  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 omfbase;
  19. {$i fpcdefs.inc}
  20. interface
  21. {$H+}
  22. uses
  23. cclasses,
  24. owbase;
  25. const
  26. { OMF record types }
  27. RT_THEADR = $80; { Translator Header Record }
  28. RT_LHEADR = $82; { Library Module Header Record }
  29. RT_COMENT = $88; { Comment Record }
  30. RT_MODEND = $8A; { Module End Record }
  31. RT_MODEND32 = $8B;
  32. RT_EXTDEF = $8C; { External Names Definition Record }
  33. RT_PUBDEF = $90; { Public Names Definition Record }
  34. RT_PUBDEF32 = $91;
  35. RT_LINNUM = $94; { Line Numbers Record }
  36. RT_LINNUM32 = $95;
  37. RT_LNAMES = $96; { List of Names Record }
  38. RT_SEGDEF = $98; { Segment Definition Record }
  39. RT_SEGDEF32 = $99;
  40. RT_GRPDEF = $9A; { Group Definition Record }
  41. RT_FIXUPP = $9C; { Fixup Record }
  42. RT_FIXUPP32 = $9D;
  43. RT_LEDATA = $A0; { Logical Enumerated Data Record }
  44. RT_LEDATA32 = $A1;
  45. RT_LIDATA = $A2; { Logical Iterated Data Record }
  46. RT_LIDATA32 = $A3;
  47. RT_COMDEF = $B0; { Communal Names Definition Record }
  48. RT_BAKPAT = $B2; { Backpatch Record }
  49. RT_BAKPAT32 = $B3;
  50. RT_LEXTDEF = $B4; { Local External Names Definition Record }
  51. RT_LEXTDEF32 = $B5;
  52. RT_LPUBDEF = $B6; { Local Public Names Definition Record }
  53. RT_LPUBDEF32 = $B7;
  54. RT_LCOMDEF = $B8; { Local Communal Names Definition Record }
  55. RT_CEXTDEF = $BC; { COMDAT External Names Definition Record }
  56. RT_COMDAT = $C2; { Initialized Communal Data Record }
  57. RT_COMDAT32 = $C3;
  58. RT_LINSYM = $C4; { Symbol Line Numbers Record }
  59. RT_LINSYM32 = $C5;
  60. RT_ALIAS = $C6; { Alias Definition Record }
  61. RT_NBKPAT = $C8; { Named Backpatch Record }
  62. RT_NBKPAT32 = $C9;
  63. RT_LLNAMES = $CA; { Local Logical Names Definition Record }
  64. RT_VERNUM = $CC; { OMF Version Number Record }
  65. RT_VENDEXT = $CE; { Vendor-specific OMF Extension Record }
  66. RT_LIBHEAD = $F0; { Library Header Record }
  67. { OMF comment class }
  68. CC_Translator = $00; { language translator (compiler or assembler) name }
  69. CC_IntelCopyright = $01;
  70. CC_IntelReservedRangeStart = $02;
  71. CC_IntelReservedRangeEnd = $9B;
  72. CC_LibrarySpecifierObsolete = $81;
  73. CC_MsDosVersionObsolete = $9C;
  74. CC_MemoryModel = $9D;
  75. CC_DOSSEG = $9E;
  76. CC_DefaultLibrarySearchName = $9F;
  77. CC_OmfExtension = $A0;
  78. CC_NewOmfExtension = $A1;
  79. CC_LinkPassSeparator = $A2;
  80. CC_LIBMOD = $A3;
  81. CC_EXESTR = $A4;
  82. CC_INCERR = $A6;
  83. CC_NOPAD = $A7;
  84. CC_WKEXT = $A8;
  85. CC_LZEXT = $A9;
  86. CC_Comment = $DA;
  87. CC_Compiler = $DB;
  88. CC_Date = $DC;
  89. CC_Timestamp = $DD;
  90. CC_User = $DF;
  91. CC_DependencyFileBorland = $E9;
  92. CC_CommandLineMicrosoft = $FF;
  93. type
  94. TOmfSegmentAlignment = (
  95. saAbsolute = 0,
  96. saRelocatableByteAligned = 1,
  97. saRelocatableWordAligned = 2,
  98. saRelocatableParaAligned = 3,
  99. saRelocatablePageAligned = 4, { 32-bit linkers extension }
  100. saRelocatableDWordAligned = 5, { 32-bit linkers extension }
  101. saNotSupported = 6,
  102. saNotDefined = 7);
  103. TOmfSegmentCombination = (
  104. scPrivate = 0,
  105. scReserved1 = 1,
  106. scPublic = 2,
  107. scReserved3 = 3,
  108. scPublic4 = 4, { same as scPublic }
  109. scStack = 5,
  110. scCommon = 6,
  111. scPublic7 = 7); { same as scPublic }
  112. TOmfSegmentUse = (suUse16, suUse32);
  113. TOmfFixupThread = (ftThread0, ftThread1, ftThread2, ftThread3);
  114. TOmfFixupMode = (fmSelfRelative, fmSegmentRelative);
  115. TOmfFixupLocationType = (
  116. fltLoByte = 0, { low 8 bits of 16-bit offset }
  117. fltOffset = 1, { 16-bit offset }
  118. fltBase = 2, { 16-bit base (segment) }
  119. fltFarPointer = 3, { 16-bit base:16-bit offset }
  120. fltHiByte = 4, { high 8 bits of 16-bit offset }
  121. fltLoaderResolvedOffset = 5, { PharLap: Offset32 }
  122. fltUndefined6 = 6, { PharLap: Pointer48 }
  123. fltUndefined7 = 7,
  124. fltUndefined8 = 8,
  125. fltOffset32 = 9, { 32-bit offset }
  126. fltUndefined10 = 10,
  127. fltFarPointer48 = 11, { 16-bit base:32-bit offset }
  128. fltUndefined12 = 12,
  129. fltLoaderResolvedOffset32 = 13,
  130. fltUndefined14 = 14,
  131. fltUndefined15 = 15);
  132. TOmfFixupFrameMethod = (
  133. ffmSegmentIndex = 0, { SI(<segment name>) - The frame is the canonic frame of the logical
  134. segment segment defined by the index }
  135. ffmGroupIndex = 1, { GI(<group name>) - The frame is the canonic frame of the group
  136. (= the canonic frame of the logical segment from the group,
  137. located at the lowest memory address) }
  138. ffmExternalIndex = 2, { EI(<symbol name>) - The frame is determined depending on the external's public definition:
  139. * if the symbol is defined relative to a logical segment and no defined group,
  140. the frame of the logical segment is used
  141. * if the symbol is defined absolutely, without reference to a logical segment and
  142. no defined group, the FRAME NUMBER from the symbol's PUBDEF record is used
  143. * regardless of how the symbol is specified, if there's an associated group,
  144. that group's canonic frame is used }
  145. ffmFrameNumber = 3, { <FRAME NUMBER> - The frame is a directly specified constant. }
  146. ffmLocation = 4, { LOCATION - The frame is determined by the location (i.e. the canonic frame of the logical
  147. segment where the fixup location is) }
  148. ffmTarget = 5, { TARGET - The frame is determined by the target. }
  149. ffmNone = 6, { NONE - There is no frame. Used for 8089 self-relative references. }
  150. ffmUndefined = 7);
  151. TOmfFixupTargetMethod = (
  152. ftmSegmentIndex = 0, { SI(<segment name>),<displacement> }
  153. ftmGroupIndex = 1, { GI(<group name>),<displacement> }
  154. ftmExternalIndex = 2, { EI(<symbol name>),<displacement> }
  155. ftmFrameNumber = 3, { <FRAME NUMBER>,<displacement> }
  156. ftmSegmentIndexNoDisp = 4, { SI(<segment name>) }
  157. ftmGroupIndexNoDisp = 5, { GI(<group name>) }
  158. ftmExternalIndexNoDisp = 6, { EI(<symbol name>) }
  159. ftmFrameNumberNoDisp = 7); { <FRAME NUMBER> }
  160. { TOmfOrderedNameCollection }
  161. TOmfOrderedNameCollection = class
  162. private
  163. FStringList: array of string;
  164. function GetCount: Integer;
  165. function GetString(Index: Integer): string;
  166. procedure SetString(Index: Integer; AValue: string);
  167. public
  168. function Add(const S: string): Integer;
  169. procedure Clear;
  170. property Strings [Index: Integer]: string read GetString write SetString; default;
  171. property Count: Integer read GetCount;
  172. end;
  173. { TOmfRawRecord }
  174. TOmfRawRecord = class
  175. private
  176. function GetChecksumByte: Byte;
  177. function GetRecordLength: Word;
  178. function GetRecordType: Byte;
  179. procedure SetChecksumByte(AValue: Byte);
  180. procedure SetRecordLength(AValue: Word);
  181. procedure SetRecordType(AValue: Byte);
  182. public
  183. RawData: array [-3..65535] of Byte;
  184. property RecordType: Byte read GetRecordType write SetRecordType;
  185. property RecordLength: Word read GetRecordLength write SetRecordLength;
  186. function ReadStringAt(Offset: Integer; out s: string): Integer;
  187. function WriteStringAt(Offset: Integer; s: string): Integer;
  188. function ReadIndexedRef(Offset: Integer; out IndexedRef: Integer): Integer;
  189. function WriteIndexedRef(Offset: Integer; IndexedRef: Integer): Integer;
  190. procedure CalculateChecksumByte;
  191. function VerifyChecksumByte: boolean;
  192. property ChecksumByte: Byte read GetChecksumByte write SetChecksumByte;
  193. procedure ReadFrom(aReader: TObjectReader);
  194. procedure WriteTo(aWriter: TObjectWriter);
  195. end;
  196. { TOmfParsedRecord }
  197. TOmfParsedRecord = class
  198. public
  199. procedure DecodeFrom(RawRecord: TOmfRawRecord);virtual;abstract;
  200. procedure EncodeTo(RawRecord: TOmfRawRecord);virtual;abstract;
  201. end;
  202. { TOmfRecord_THEADR }
  203. TOmfRecord_THEADR = class(TOmfParsedRecord)
  204. private
  205. FModuleName: string;
  206. public
  207. procedure DecodeFrom(RawRecord: TOmfRawRecord);override;
  208. procedure EncodeTo(RawRecord: TOmfRawRecord);override;
  209. property ModuleName: string read FModuleName write FModuleName;
  210. end;
  211. { TOmfRecord_COMENT }
  212. TOmfRecord_COMENT = class(TOmfParsedRecord)
  213. private
  214. FCommentType: Byte;
  215. FCommentClass: Byte;
  216. FCommentString: string;
  217. function GetNoList: Boolean;
  218. function GetNoPurge: Boolean;
  219. procedure SetNoList(AValue: Boolean);
  220. procedure SetNoPurge(AValue: Boolean);
  221. public
  222. procedure DecodeFrom(RawRecord: TOmfRawRecord);override;
  223. procedure EncodeTo(RawRecord: TOmfRawRecord);override;
  224. property CommentType: Byte read FCommentType write FCommentType;
  225. property CommentClass: Byte read FCommentClass write FCommentClass;
  226. property CommentString: string read FCommentString write FCommentString;
  227. property NoPurge: Boolean read GetNoPurge write SetNoPurge;
  228. property NoList: Boolean read GetNoList write SetNoList;
  229. end;
  230. { TOmfRecord_LNAMES }
  231. TOmfRecord_LNAMES = class(TOmfParsedRecord)
  232. private
  233. FNames: TOmfOrderedNameCollection;
  234. FNextIndex: Integer;
  235. public
  236. constructor Create;
  237. procedure DecodeFrom(RawRecord: TOmfRawRecord);override;
  238. procedure EncodeTo(RawRecord: TOmfRawRecord);override;
  239. property Names: TOmfOrderedNameCollection read FNames write FNames;
  240. property NextIndex: Integer read FNextIndex write FNextIndex;
  241. end;
  242. { TOmfRecord_SEGDEF }
  243. TOmfRecord_SEGDEF = class(TOmfParsedRecord)
  244. private
  245. FAlignment: TOmfSegmentAlignment;
  246. FCombination: TOmfSegmentCombination;
  247. FUse: TOmfSegmentUse;
  248. FFrameNumber: Word;
  249. FOffset: Byte;
  250. FIs32Bit: Boolean;
  251. FSegmentLength: Int64; { int64, because it can be 2**32 }
  252. FSegmentNameIndex: Integer;
  253. FClassNameIndex: Integer;
  254. FOverlayNameIndex: Integer;
  255. public
  256. procedure DecodeFrom(RawRecord: TOmfRawRecord);override;
  257. procedure EncodeTo(RawRecord: TOmfRawRecord);override;
  258. property Alignment: TOmfSegmentAlignment read FAlignment write FAlignment;
  259. property Combination: TOmfSegmentCombination read FCombination write FCombination;
  260. property Use: TOmfSegmentUse read FUse write FUse;
  261. property FrameNumber: Word read FFrameNumber write FFrameNumber;
  262. property Offset: Byte read FOffset write FOffset;
  263. property Is32Bit: Boolean read FIs32Bit write FIs32Bit;
  264. property SegmentLength: Int64 read FSegmentLength write FSegmentLength;
  265. property SegmentNameIndex: Integer read FSegmentNameIndex write FSegmentNameIndex;
  266. property ClassNameIndex: Integer read FClassNameIndex write FClassNameIndex;
  267. property OverlayNameIndex: Integer read FOverlayNameIndex write FOverlayNameIndex;
  268. end;
  269. TSegmentList = array of Integer;
  270. { TOmfRecord_GRPDEF }
  271. TOmfRecord_GRPDEF = class(TOmfParsedRecord)
  272. private
  273. FGroupNameIndex: Integer;
  274. FSegmentList: TSegmentList;
  275. public
  276. procedure DecodeFrom(RawRecord: TOmfRawRecord);override;
  277. procedure EncodeTo(RawRecord: TOmfRawRecord);override;
  278. property GroupNameIndex: Integer read FGroupNameIndex write FGroupNameIndex;
  279. property SegmentList: TSegmentList read FSegmentList write FSegmentList;
  280. end;
  281. { TOmfPublicNameElement }
  282. TOmfPublicNameElement = class(TFPHashObject)
  283. private
  284. FPublicOffset: DWord;
  285. FTypeIndex: Integer;
  286. public
  287. function GetLengthInFile(Is32Bit: Boolean): Integer;
  288. property PublicOffset: DWord read FPublicOffset write FPublicOffset;
  289. property TypeIndex: Integer read FTypeIndex write FTypeIndex;
  290. end;
  291. { TOmfRecord_PUBDEF }
  292. TOmfRecord_PUBDEF = class(TOmfParsedRecord)
  293. private
  294. FIs32Bit: Boolean;
  295. FBaseGroupIndex: Integer;
  296. FBaseSegmentIndex: Integer;
  297. FBaseFrame: Word;
  298. FPublicNames: TFPHashObjectList;
  299. FNextIndex: Integer;
  300. public
  301. procedure DecodeFrom(RawRecord: TOmfRawRecord);override;
  302. procedure EncodeTo(RawRecord: TOmfRawRecord);override;
  303. property Is32Bit: Boolean read FIs32Bit write FIs32Bit;
  304. property BaseGroupIndex: Integer read FBaseGroupIndex write FBaseGroupIndex;
  305. property BaseSegmentIndex: Integer read FBaseSegmentIndex write FBaseSegmentIndex;
  306. property BaseFrame: Word read FBaseFrame write FBaseFrame;
  307. property PublicNames: TFPHashObjectList read FPublicNames write FPublicNames;
  308. property NextIndex: Integer read FNextIndex write FNextIndex;
  309. end;
  310. { TOmfExternalNameElement }
  311. TOmfExternalNameElement = class(TFPHashObject)
  312. private
  313. FTypeIndex: Integer;
  314. public
  315. function GetLengthInFile: Integer;
  316. property TypeIndex: Integer read FTypeIndex write FTypeIndex;
  317. end;
  318. { TOmfRecord_EXTDEF }
  319. TOmfRecord_EXTDEF = class(TOmfParsedRecord)
  320. private
  321. FExternalNames: TFPHashObjectList;
  322. FNextIndex: Integer;
  323. public
  324. procedure DecodeFrom(RawRecord: TOmfRawRecord);override;
  325. procedure EncodeTo(RawRecord: TOmfRawRecord);override;
  326. property ExternalNames: TFPHashObjectList read FExternalNames write FExternalNames;
  327. property NextIndex: Integer read FNextIndex write FNextIndex;
  328. end;
  329. { TOmfRecord_MODEND }
  330. TOmfRecord_MODEND = class(TOmfParsedRecord)
  331. private
  332. FIs32Bit: Boolean;
  333. FIsMainModule: Boolean;
  334. FHasStartAddress: Boolean;
  335. FSegmentBit: Boolean;
  336. FLogicalStartAddress: Boolean;
  337. FFrameMethod: TOmfFixupFrameMethod;
  338. FFrameDatum: Integer;
  339. FTargetMethod: TOmfFixupTargetMethod;
  340. FTargetDatum: Integer;
  341. FTargetDisplacement: DWord;
  342. FPhysFrameNumber: Word;
  343. FPhysOffset: DWord;
  344. public
  345. procedure DecodeFrom(RawRecord: TOmfRawRecord);override;
  346. procedure EncodeTo(RawRecord: TOmfRawRecord);override;
  347. property Is32Bit: Boolean read FIs32Bit write FIs32Bit;
  348. property IsMainModule: Boolean read FIsMainModule write FIsMainModule;
  349. property HasStartAddress: Boolean read FHasStartAddress write FHasStartAddress;
  350. property SegmentBit: Boolean read FSegmentBit write FSegmentBit;
  351. property LogicalStartAddress: Boolean read FLogicalStartAddress write FLogicalStartAddress;
  352. { properties, specifying a logical start address (used when LogicalStartAddress=true) }
  353. property FrameMethod: TOmfFixupFrameMethod read FFrameMethod write FFrameMethod;
  354. property FrameDatum: Integer read FFrameDatum write FFrameDatum;
  355. property TargetMethod: TOmfFixupTargetMethod read FTargetMethod write FTargetMethod;
  356. property TargetDatum: Integer read FTargetDatum write FTargetDatum;
  357. property TargetDisplacement: DWord read FTargetDisplacement write FTargetDisplacement;
  358. { properties, specifying a physical start address (used when LogicalStartAddress=false) }
  359. property PhysFrameNumber: Word read FPhysFrameNumber write FPhysFrameNumber;
  360. property PhysOffset: DWord read FPhysOffset write FPhysOffset;
  361. end;
  362. { TOmfSubRecord_FIXUP }
  363. TOmfSubRecord_FIXUP = class
  364. private
  365. FIs32Bit: Boolean;
  366. FMode: TOmfFixupMode;
  367. FLocationType: TOmfFixupLocationType;
  368. FLocationOffset: DWord;
  369. FDataRecordStartOffset: DWord;
  370. FTargetDeterminedByThread: Boolean;
  371. FTargetThread: TOmfFixupThread;
  372. FTargetThreadDisplacementPresent: Boolean;
  373. FTargetMethod: TOmfFixupTargetMethod;
  374. FTargetDatum: Integer;
  375. FTargetDisplacement: DWord;
  376. FFrameDeterminedByThread: Boolean;
  377. FFrameThread: TOmfFixupThread;
  378. FFrameMethod: TOmfFixupFrameMethod;
  379. FFrameDatum: Integer;
  380. function GetDataRecordOffset: Integer;
  381. procedure SetDataRecordOffset(AValue: Integer);
  382. public
  383. function ReadAt(RawRecord: TOmfRawRecord; Offset: Integer): Integer;
  384. function WriteAt(RawRecord: TOmfRawRecord; Offset: Integer): Integer;
  385. property Is32Bit: Boolean read FIs32Bit write FIs32Bit;
  386. property Mode: TOmfFixupMode read FMode write FMode;
  387. property LocationType: TOmfFixupLocationType read FLocationType write FLocationType;
  388. property LocationOffset: DWord read FLocationOffset write FLocationOffset;
  389. property DataRecordStartOffset: DWord read FDataRecordStartOffset write FDataRecordStartOffset;
  390. property DataRecordOffset: Integer read GetDataRecordOffset write SetDataRecordOffset;
  391. property TargetDeterminedByThread: Boolean read FTargetDeterminedByThread write FTargetDeterminedByThread;
  392. property TargetThread: TOmfFixupThread read FTargetThread write FTargetThread;
  393. property TargetThreadDisplacementPresent: Boolean read FTargetThreadDisplacementPresent write FTargetThreadDisplacementPresent;
  394. property TargetMethod: TOmfFixupTargetMethod read FTargetMethod write FTargetMethod;
  395. property TargetDatum: Integer read FTargetDatum write FTargetDatum;
  396. property TargetDisplacement: DWord read FTargetDisplacement write FTargetDisplacement;
  397. property FrameDeterminedByThread: Boolean read FFrameDeterminedByThread write FFrameDeterminedByThread;
  398. property FrameThread: TOmfFixupThread read FFrameThread write FFrameThread;
  399. property FrameMethod: TOmfFixupFrameMethod read FFrameMethod write FFrameMethod;
  400. property FrameDatum: Integer read FFrameDatum write FFrameDatum;
  401. end;
  402. { TOmfRecord_LIBHEAD }
  403. TOmfRecord_LIBHEAD = class(TOmfParsedRecord)
  404. private
  405. FPageSize: Integer;
  406. FDictionaryOffset: DWord;
  407. FDictionarySizeInBlocks: Word;
  408. FFlags: Byte;
  409. function IsCaseSensitive: Boolean;
  410. procedure SetCaseSensitive(AValue: Boolean);
  411. procedure SetPageSize(AValue: Integer);
  412. public
  413. constructor Create;
  414. procedure DecodeFrom(RawRecord: TOmfRawRecord);override;
  415. procedure EncodeTo(RawRecord: TOmfRawRecord);override;
  416. property PageSize: Integer read FPageSize write SetPageSize;
  417. property DictionaryOffset: DWord read FDictionaryOffset write FDictionaryOffset;
  418. property DictionarySizeInBlocks: Word read FDictionarySizeInBlocks write FDictionarySizeInBlocks;
  419. property Flags: Byte read FFlags write FFlags;
  420. property CaseSensitive: Boolean read IsCaseSensitive write SetCaseSensitive;
  421. end;
  422. TOmfLibHash = record
  423. block_x: Integer;
  424. block_d: Integer;
  425. bucket_x: Integer;
  426. bucket_d: Integer;
  427. end;
  428. function compute_omf_lib_hash(const name: string; blocks: Integer): TOmfLibHash;
  429. implementation
  430. uses
  431. cutils,
  432. verbose;
  433. { TOmfOrderedNameCollection }
  434. function TOmfOrderedNameCollection.GetString(Index: Integer): string;
  435. begin
  436. Result:=FStringList[Index-1];
  437. end;
  438. function TOmfOrderedNameCollection.GetCount: Integer;
  439. begin
  440. Result:=Length(FStringList);
  441. end;
  442. procedure TOmfOrderedNameCollection.SetString(Index: Integer; AValue: string);
  443. begin
  444. FStringList[Index-1]:=AValue;
  445. end;
  446. function TOmfOrderedNameCollection.Add(const S: string): Integer;
  447. begin
  448. Result:=Length(FStringList)+1;
  449. SetLength(FStringList,Result);
  450. FStringList[Result-1]:=S;
  451. end;
  452. procedure TOmfOrderedNameCollection.Clear;
  453. begin
  454. SetLength(FStringList,0);
  455. end;
  456. { TOmfRawRecord }
  457. function TOmfRawRecord.GetRecordType: Byte;
  458. begin
  459. Result:=RawData[-3];
  460. end;
  461. procedure TOmfRawRecord.SetRecordType(AValue: Byte);
  462. begin
  463. RawData[-3]:=AValue;
  464. end;
  465. function TOmfRawRecord.GetRecordLength: Word;
  466. begin
  467. Result:=RawData[-2] or (RawData[-1] shl 8);
  468. end;
  469. procedure TOmfRawRecord.SetRecordLength(AValue: Word);
  470. begin
  471. RawData[-2]:=Byte(AValue);
  472. RawData[-1]:=Byte(AValue shr 8);
  473. end;
  474. function TOmfRawRecord.ReadStringAt(Offset: Integer; out s: string): Integer;
  475. var
  476. len: Byte;
  477. begin
  478. len:=RawData[Offset];
  479. Result:=Offset+len+1;
  480. if result>RecordLength then
  481. internalerror(2015033103);
  482. SetLength(s, len);
  483. UniqueString(s);
  484. Move(RawData[Offset+1],s[1],len);
  485. end;
  486. function TOmfRawRecord.WriteStringAt(Offset: Integer; s: string): Integer;
  487. begin
  488. if Length(s)>255 then
  489. internalerror(2015033101);
  490. result:=Offset+Length(s)+1;
  491. if result>High(RawData) then
  492. internalerror(2015033102);
  493. RawData[Offset]:=Length(s);
  494. Move(s[1], RawData[Offset+1], Length(s));
  495. end;
  496. function TOmfRawRecord.ReadIndexedRef(Offset: Integer; out IndexedRef: Integer): Integer;
  497. begin
  498. Result:=Offset+1;
  499. if result>RecordLength then
  500. internalerror(2015033103);
  501. IndexedRef:=RawData[Offset];
  502. if IndexedRef<=$7f then
  503. exit;
  504. Result:=Offset+2;
  505. if result>RecordLength then
  506. internalerror(2015033103);
  507. IndexedRef:=((IndexedRef and $7f) shl 8)+RawData[Offset+1];
  508. end;
  509. function TOmfRawRecord.WriteIndexedRef(Offset: Integer; IndexedRef: Integer): Integer;
  510. begin
  511. if (IndexedRef<0) or (IndexedRef>$7FFF) then
  512. internalerror(2015040303);
  513. if IndexedRef<=$7f then
  514. begin
  515. Result:=Offset+1;
  516. if Result>High(RawData) then
  517. internalerror(2015033102);
  518. RawData[Offset]:=IndexedRef;
  519. end
  520. else
  521. begin
  522. Result:=Offset+2;
  523. if Result>High(RawData) then
  524. internalerror(2015033102);
  525. RawData[Offset]:=$80+(IndexedRef shr 8);
  526. RawData[Offset+1]:=Byte(IndexedRef);
  527. end;
  528. end;
  529. function TOmfRawRecord.GetChecksumByte: Byte;
  530. begin
  531. if RecordLength>0 then
  532. Result:=RawData[RecordLength-1]
  533. else
  534. Result:=0;
  535. end;
  536. procedure TOmfRawRecord.SetChecksumByte(AValue: Byte);
  537. begin
  538. if RecordLength>0 then
  539. RawData[RecordLength-1]:=AValue;
  540. end;
  541. procedure TOmfRawRecord.CalculateChecksumByte;
  542. var
  543. I: Integer;
  544. b: Byte;
  545. begin
  546. b:=0;
  547. for I:=-3 to RecordLength-2 do
  548. b:=byte(b+RawData[I]);
  549. SetChecksumByte($100-b);
  550. end;
  551. function TOmfRawRecord.VerifyChecksumByte: boolean;
  552. var
  553. I: Integer;
  554. b: Byte;
  555. begin
  556. { according to the OMF spec, some tools always write a 0 rather than
  557. computing the checksum, so it should also be accepted as correct }
  558. if ChecksumByte=0 then
  559. exit(true);
  560. b:=0;
  561. for I:=-3 to RecordLength-1 do
  562. b:=byte(b+RawData[I]);
  563. Result:=(b=0);
  564. end;
  565. procedure TOmfRawRecord.ReadFrom(aReader: TObjectReader);
  566. begin
  567. aReader.read(RawData, 3);
  568. aReader.read(RawData[0], RecordLength);
  569. end;
  570. procedure TOmfRawRecord.WriteTo(aWriter: TObjectWriter);
  571. begin
  572. aWriter.write(RawData, RecordLength+3);
  573. end;
  574. { TOmfRecord_THEADR }
  575. procedure TOmfRecord_THEADR.DecodeFrom(RawRecord: TOmfRawRecord);
  576. begin
  577. if RawRecord.RecordType<>RT_THEADR then
  578. internalerror(2015040301);
  579. RawRecord.ReadStringAt(0,FModuleName);
  580. end;
  581. procedure TOmfRecord_THEADR.EncodeTo(RawRecord: TOmfRawRecord);
  582. var
  583. NextOfs: Integer;
  584. begin
  585. RawRecord.RecordType:=RT_THEADR;
  586. NextOfs:=RawRecord.WriteStringAt(0,ModuleName);
  587. RawRecord.RecordLength:=NextOfs+1;
  588. RawRecord.CalculateChecksumByte;
  589. end;
  590. { TOmfRecord_COMENT }
  591. function TOmfRecord_COMENT.GetNoList: Boolean;
  592. begin
  593. Result:=(CommentType and $40)<>0;
  594. end;
  595. function TOmfRecord_COMENT.GetNoPurge: Boolean;
  596. begin
  597. Result:=(CommentType and $80)<>0;
  598. end;
  599. procedure TOmfRecord_COMENT.SetNoList(AValue: Boolean);
  600. begin
  601. if AValue then
  602. CommentType:=CommentType or $40
  603. else
  604. CommentType:=CommentType and $BF;
  605. end;
  606. procedure TOmfRecord_COMENT.SetNoPurge(AValue: Boolean);
  607. begin
  608. if AValue then
  609. CommentType:=CommentType or $80
  610. else
  611. CommentType:=CommentType and $7F;
  612. end;
  613. procedure TOmfRecord_COMENT.DecodeFrom(RawRecord: TOmfRawRecord);
  614. begin
  615. if RawRecord.RecordType<>RT_COMENT then
  616. internalerror(2015040301);
  617. if RawRecord.RecordLength<3 then
  618. internalerror(2015033104);
  619. CommentType:=RawRecord.RawData[0];
  620. CommentClass:=RawRecord.RawData[1];
  621. SetLength(FCommentString,RawRecord.RecordLength-3);
  622. UniqueString(FCommentString);
  623. Move(RawRecord.RawData[2],FCommentString[1],Length(FCommentString));
  624. end;
  625. procedure TOmfRecord_COMENT.EncodeTo(RawRecord: TOmfRawRecord);
  626. begin
  627. RawRecord.RecordType:=RT_COMENT;
  628. if (Length(FCommentString)+3)>High(RawRecord.RawData) then
  629. internalerror(2015033105);
  630. RawRecord.RecordLength:=Length(FCommentString)+3;
  631. RawRecord.RawData[0]:=CommentType;
  632. RawRecord.RawData[1]:=CommentClass;
  633. Move(FCommentString[1],RawRecord.RawData[2],Length(FCommentString));
  634. RawRecord.CalculateChecksumByte;
  635. end;
  636. { TOmfRecord_LNAMES }
  637. constructor TOmfRecord_LNAMES.Create;
  638. begin
  639. FNextIndex:=1;
  640. end;
  641. procedure TOmfRecord_LNAMES.DecodeFrom(RawRecord: TOmfRawRecord);
  642. var
  643. NextOfs: Integer;
  644. Name: string;
  645. begin
  646. if RawRecord.RecordType<>RT_LNAMES then
  647. internalerror(2015040301);
  648. NextOfs:=0;
  649. while NextOfs<(RawRecord.RecordLength-1) do
  650. begin
  651. NextOfs:=RawRecord.ReadStringAt(NextOfs,Name);
  652. Names.Add(Name);
  653. end;
  654. end;
  655. procedure TOmfRecord_LNAMES.EncodeTo(RawRecord: TOmfRawRecord);
  656. const
  657. RecordLengthLimit = 1024;
  658. var
  659. Len,LastIncludedIndex,NextOfs,I: Integer;
  660. begin
  661. RawRecord.RecordType:=RT_LNAMES;
  662. { find out how many strings can we include until we reach the length limit }
  663. Len:=1;
  664. LastIncludedIndex:=NextIndex-1;
  665. repeat
  666. Inc(LastIncludedIndex);
  667. Inc(Len,Length(Names[LastIncludedIndex])+1);
  668. until (LastIncludedIndex>=Names.Count) or ((Len+Length(Names[LastIncludedIndex+1])+1)>=RecordLengthLimit);
  669. { write the strings... }
  670. NextOfs:=0;
  671. for I:=NextIndex to LastIncludedIndex do
  672. NextOfs:=RawRecord.WriteStringAt(NextOfs,Names[I]);
  673. RawRecord.RecordLength:=Len;
  674. RawRecord.CalculateChecksumByte;
  675. { update NextIndex }
  676. NextIndex:=LastIncludedIndex+1;
  677. end;
  678. { TOmfRecord_SEGDEF }
  679. procedure TOmfRecord_SEGDEF.DecodeFrom(RawRecord: TOmfRawRecord);
  680. var
  681. B: Byte;
  682. Big: Boolean;
  683. NextOfs: Integer;
  684. MinLen: Integer;
  685. begin
  686. if not (RawRecord.RecordType in [RT_SEGDEF,RT_SEGDEF32]) then
  687. internalerror(2015040301);
  688. Is32Bit:=RawRecord.RecordType=RT_SEGDEF32;
  689. MinLen:=7; { b(1)+seglength(2..4)+segnameindex(1..2)+classnameindex(1..2)+overlaynameindex(1..2)+checksum }
  690. if Is32Bit then
  691. inc(MinLen,2);
  692. if RawRecord.RecordLength<MinLen then
  693. internalerror(2015040305);
  694. B:=RawRecord.RawData[0];
  695. Alignment:=TOmfSegmentAlignment(B shr 5);
  696. Combination:=TOmfSegmentCombination((B shr 2) and 7);
  697. Big:=(B and 2)<>0;
  698. Use:=TOmfSegmentUse(B and 1);
  699. NextOfs:=1;
  700. if Alignment=saAbsolute then
  701. begin
  702. inc(MinLen,3);
  703. if RawRecord.RecordLength<MinLen then
  704. internalerror(2015040305);
  705. FrameNumber:=RawRecord.RawData[1]+(RawRecord.RawData[2] shl 8);
  706. Offset:=RawRecord.RawData[3];
  707. NextOfs:=4;
  708. end
  709. else
  710. begin
  711. FrameNumber:=0;
  712. Offset:=0;
  713. end;
  714. if Is32Bit then
  715. begin
  716. SegmentLength:=RawRecord.RawData[NextOfs]+
  717. (RawRecord.RawData[NextOfs+1] shl 8)+
  718. (RawRecord.RawData[NextOfs+2] shl 16)+
  719. (RawRecord.RawData[NextOfs+3] shl 24);
  720. if Big then
  721. if SegmentLength=0 then
  722. SegmentLength:=4294967296
  723. else
  724. internalerror(2015040306);
  725. Inc(NextOfs,4);
  726. end
  727. else
  728. begin
  729. SegmentLength:=RawRecord.RawData[NextOfs]+(RawRecord.RawData[NextOfs+1] shl 8);
  730. if Big then
  731. if SegmentLength=0 then
  732. SegmentLength:=65536
  733. else
  734. internalerror(2015040306);
  735. Inc(NextOfs,2);
  736. end;
  737. NextOfs:=RawRecord.ReadIndexedRef(NextOfs,FSegmentNameIndex);
  738. NextOfs:=RawRecord.ReadIndexedRef(NextOfs,FClassNameIndex);
  739. NextOfs:=RawRecord.ReadIndexedRef(NextOfs,FOverlayNameIndex);
  740. end;
  741. procedure TOmfRecord_SEGDEF.EncodeTo(RawRecord: TOmfRawRecord);
  742. var
  743. Big: Boolean;
  744. NextOfs: Integer;
  745. begin
  746. if Is32Bit then
  747. begin
  748. RawRecord.RecordType:=RT_SEGDEF32;
  749. if SegmentLength>4294967296 then
  750. internalerror(2015040302);
  751. Big:=SegmentLength=4294967296;
  752. end
  753. else
  754. begin
  755. RawRecord.RecordType:=RT_SEGDEF;
  756. if SegmentLength>65536 then
  757. internalerror(2015040302);
  758. Big:=SegmentLength=65536;
  759. end;
  760. RawRecord.RawData[0]:=(Ord(Alignment) shl 5) or (Ord(Combination) shl 2) or (Ord(Big) shl 1) or Ord(Use);
  761. NextOfs:=1;
  762. if Alignment=saAbsolute then
  763. begin
  764. RawRecord.RawData[1]:=Byte(FrameNumber);
  765. RawRecord.RawData[2]:=Byte(FrameNumber shr 8);
  766. RawRecord.RawData[3]:=Offset;
  767. NextOfs:=4;
  768. end;
  769. if Is32Bit then
  770. begin
  771. RawRecord.RawData[NextOfs]:=Byte(SegmentLength);
  772. RawRecord.RawData[NextOfs+1]:=Byte(SegmentLength shr 8);
  773. RawRecord.RawData[NextOfs+2]:=Byte(SegmentLength shr 16);
  774. RawRecord.RawData[NextOfs+3]:=Byte(SegmentLength shr 24);
  775. Inc(NextOfs,4);
  776. end
  777. else
  778. begin
  779. RawRecord.RawData[NextOfs]:=Byte(SegmentLength);
  780. RawRecord.RawData[NextOfs+1]:=Byte(SegmentLength shr 8);
  781. Inc(NextOfs,2);
  782. end;
  783. NextOfs:=RawRecord.WriteIndexedRef(NextOfs,SegmentNameIndex);
  784. NextOfs:=RawRecord.WriteIndexedRef(NextOfs,ClassNameIndex);
  785. NextOfs:=RawRecord.WriteIndexedRef(NextOfs,OverlayNameIndex);
  786. RawRecord.RecordLength:=NextOfs+1;
  787. RawRecord.CalculateChecksumByte;
  788. end;
  789. { TOmfRecord_GRPDEF }
  790. procedure TOmfRecord_GRPDEF.DecodeFrom(RawRecord: TOmfRawRecord);
  791. var
  792. NextOfs: Integer;
  793. Segment: Integer;
  794. begin
  795. if RawRecord.RecordType<>RT_GRPDEF then
  796. internalerror(2015040301);
  797. NextOfs:=RawRecord.ReadIndexedRef(0,FGroupNameIndex);
  798. SetLength(FSegmentList,0);
  799. while NextOfs<RawRecord.RecordLength-1 do
  800. begin
  801. if RawRecord.RawData[NextOfs]<>$ff then
  802. internalerror(2015040901);
  803. NextOfs:=RawRecord.ReadIndexedRef(NextOfs+1,Segment);
  804. SetLength(FSegmentList,Length(FSegmentList)+1);
  805. FSegmentList[High(FSegmentList)]:=Segment;
  806. end;
  807. end;
  808. procedure TOmfRecord_GRPDEF.EncodeTo(RawRecord: TOmfRawRecord);
  809. var
  810. NextOfs: Integer;
  811. Segment: Integer;
  812. begin
  813. RawRecord.RecordType:=RT_GRPDEF;
  814. NextOfs:=RawRecord.WriteIndexedRef(0,GroupNameIndex);
  815. for Segment in SegmentList do
  816. begin
  817. if NextOfs>High(RawRecord.RawData) then
  818. internalerror(2015040401);
  819. RawRecord.RawData[NextOfs]:=$ff;
  820. NextOfs:=RawRecord.WriteIndexedRef(NextOfs+1,Segment);
  821. end;
  822. RawRecord.RecordLength:=NextOfs+1;
  823. RawRecord.CalculateChecksumByte;
  824. end;
  825. { TOmfPublicNameElement }
  826. function TOmfPublicNameElement.GetLengthInFile(Is32Bit: Boolean): Integer;
  827. begin
  828. Result:=1+Length(Name)+2+1;
  829. if Is32Bit then
  830. Inc(Result,2);
  831. if TypeIndex>=$80 then
  832. Inc(Result);
  833. end;
  834. { TOmfRecord_PUBDEF }
  835. procedure TOmfRecord_PUBDEF.DecodeFrom(RawRecord: TOmfRawRecord);
  836. var
  837. NextOfs: Integer;
  838. Name: string;
  839. TypeIndex: Integer;
  840. PublicOffset: DWord;
  841. PubName: TOmfPublicNameElement;
  842. begin
  843. if not (RawRecord.RecordType in [RT_PUBDEF,RT_PUBDEF32]) then
  844. internalerror(2015040301);
  845. Is32Bit:=RawRecord.RecordType=RT_PUBDEF32;
  846. NextOfs:=RawRecord.ReadIndexedRef(0,FBaseGroupIndex);
  847. NextOfs:=RawRecord.ReadIndexedRef(NextOfs,FBaseSegmentIndex);
  848. if BaseSegmentIndex=0 then
  849. begin
  850. if (NextOfs+1)>=RawRecord.RecordLength then
  851. internalerror(2015041401);
  852. BaseFrame:=RawRecord.RawData[NextOfs]+(RawRecord.RawData[NextOfs+1] shl 8);
  853. Inc(NextOfs,2);
  854. end
  855. else
  856. BaseFrame:=0;
  857. while NextOfs<(RawRecord.RecordLength-1) do
  858. begin
  859. NextOfs:=RawRecord.ReadStringAt(NextOfs,Name);
  860. if Is32Bit then
  861. begin
  862. if (NextOfs+3)>=RawRecord.RecordLength then
  863. internalerror(2015041401);
  864. PublicOffset:=RawRecord.RawData[NextOfs]+(RawRecord.RawData[NextOfs+1] shl 8)+
  865. (RawRecord.RawData[NextOfs+2] shl 16)+(RawRecord.RawData[NextOfs+3] shl 24);
  866. Inc(NextOfs,4);
  867. end
  868. else
  869. begin
  870. if (NextOfs+1)>=RawRecord.RecordLength then
  871. internalerror(2015041401);
  872. PublicOffset:=RawRecord.RawData[NextOfs]+(RawRecord.RawData[NextOfs+1] shl 8);
  873. Inc(NextOfs,2);
  874. end;
  875. NextOfs:=RawRecord.ReadIndexedRef(NextOfs,TypeIndex);
  876. PubName:=TOmfPublicNameElement.Create(PublicNames,Name);
  877. PubName.PublicOffset:=PublicOffset;
  878. PubName.TypeIndex:=TypeIndex;
  879. end;
  880. end;
  881. procedure TOmfRecord_PUBDEF.EncodeTo(RawRecord: TOmfRawRecord);
  882. const
  883. RecordLengthLimit = 1024;
  884. var
  885. Len,LastIncludedIndex,NextOfs,I: Integer;
  886. PubName: TOmfPublicNameElement;
  887. begin
  888. if Is32Bit then
  889. RawRecord.RecordType:=RT_PUBDEF32
  890. else
  891. RawRecord.RecordType:=RT_PUBDEF;
  892. NextOfs:=RawRecord.WriteIndexedRef(0,BaseGroupIndex);
  893. NextOfs:=RawRecord.WriteIndexedRef(NextOfs,BaseSegmentIndex);
  894. if BaseSegmentIndex=0 then
  895. begin
  896. RawRecord.RawData[NextOfs]:=Byte(BaseFrame);
  897. RawRecord.RawData[NextOfs+1]:=Byte(BaseFrame shr 8);
  898. Inc(NextOfs,2);
  899. end;
  900. { find out how many public names can we include until we reach the length limit }
  901. Len:=NextOfs;
  902. LastIncludedIndex:=NextIndex-1;
  903. repeat
  904. Inc(LastIncludedIndex);
  905. Inc(Len,TOmfPublicNameElement(PublicNames[LastIncludedIndex]).GetLengthInFile(Is32Bit));
  906. until (LastIncludedIndex>=(PublicNames.Count-1)) or ((Len+TOmfPublicNameElement(PublicNames[LastIncludedIndex+1]).GetLengthInFile(Is32Bit))>=RecordLengthLimit);
  907. { write the public names... }
  908. for I:=NextIndex to LastIncludedIndex do
  909. begin
  910. PubName:=TOmfPublicNameElement(PublicNames[I]);
  911. NextOfs:=RawRecord.WriteStringAt(NextOfs,PubName.Name);
  912. if Is32Bit then
  913. begin
  914. RawRecord.RawData[NextOfs]:=Byte(PubName.PublicOffset);
  915. RawRecord.RawData[NextOfs+1]:=Byte(PubName.PublicOffset shr 8);
  916. RawRecord.RawData[NextOfs+2]:=Byte(PubName.PublicOffset shr 16);
  917. RawRecord.RawData[NextOfs+3]:=Byte(PubName.PublicOffset shr 24);
  918. Inc(NextOfs,4);
  919. end
  920. else
  921. begin
  922. if PubName.PublicOffset>$ffff then
  923. internalerror(2015041403);
  924. RawRecord.RawData[NextOfs]:=Byte(PubName.PublicOffset);
  925. RawRecord.RawData[NextOfs+1]:=Byte(PubName.PublicOffset shr 8);
  926. Inc(NextOfs,2);
  927. end;
  928. NextOfs:=RawRecord.WriteIndexedRef(NextOfs,PubName.TypeIndex);
  929. end;
  930. RawRecord.RecordLength:=Len+1;
  931. RawRecord.CalculateChecksumByte;
  932. { update NextIndex }
  933. NextIndex:=LastIncludedIndex+1;
  934. end;
  935. { TOmfExternalNameElement }
  936. function TOmfExternalNameElement.GetLengthInFile: Integer;
  937. begin
  938. Result:=1+Length(Name)+1;
  939. if TypeIndex>=$80 then
  940. Inc(Result);
  941. end;
  942. { TOmfRecord_EXTDEF }
  943. procedure TOmfRecord_EXTDEF.DecodeFrom(RawRecord: TOmfRawRecord);
  944. var
  945. NextOfs: Integer;
  946. Name: string;
  947. TypeIndex: Integer;
  948. ExtName: TOmfExternalNameElement;
  949. begin
  950. if RawRecord.RecordType<>RT_EXTDEF then
  951. internalerror(2015040301);
  952. NextOfs:=0;
  953. while NextOfs<(RawRecord.RecordLength-1) do
  954. begin
  955. NextOfs:=RawRecord.ReadStringAt(NextOfs,Name);
  956. NextOfs:=RawRecord.ReadIndexedRef(NextOfs,TypeIndex);
  957. ExtName:=TOmfExternalNameElement.Create(ExternalNames,Name);
  958. ExtName.TypeIndex:=TypeIndex;
  959. end;
  960. end;
  961. procedure TOmfRecord_EXTDEF.EncodeTo(RawRecord: TOmfRawRecord);
  962. const
  963. RecordLengthLimit = 1024;
  964. var
  965. Len,LastIncludedIndex,NextOfs,I: Integer;
  966. ExtName: TOmfExternalNameElement;
  967. begin
  968. RawRecord.RecordType:=RT_EXTDEF;
  969. NextOfs:=0;
  970. { find out how many external names can we include until we reach the length limit }
  971. Len:=NextOfs;
  972. LastIncludedIndex:=NextIndex-1;
  973. repeat
  974. Inc(LastIncludedIndex);
  975. Inc(Len,TOmfExternalNameElement(ExternalNames[LastIncludedIndex]).GetLengthInFile);
  976. until (LastIncludedIndex>=(ExternalNames.Count-1)) or ((Len+TOmfExternalNameElement(ExternalNames[LastIncludedIndex+1]).GetLengthInFile)>=RecordLengthLimit);
  977. { write the external names... }
  978. for I:=NextIndex to LastIncludedIndex do
  979. begin
  980. ExtName:=TOmfExternalNameElement(ExternalNames[I]);
  981. NextOfs:=RawRecord.WriteStringAt(NextOfs,ExtName.Name);
  982. NextOfs:=RawRecord.WriteIndexedRef(NextOfs,ExtName.TypeIndex);
  983. end;
  984. RawRecord.RecordLength:=Len+1;
  985. RawRecord.CalculateChecksumByte;
  986. { update NextIndex }
  987. NextIndex:=LastIncludedIndex+1;
  988. end;
  989. { TOmfRecord_MODEND }
  990. procedure TOmfRecord_MODEND.DecodeFrom(RawRecord: TOmfRawRecord);
  991. var
  992. ModTyp: Byte;
  993. NextOfs: Integer;
  994. EndData: Byte;
  995. begin
  996. if not (RawRecord.RecordType in [RT_MODEND,RT_MODEND32]) then
  997. internalerror(2015040301);
  998. Is32Bit:=RawRecord.RecordType=RT_MODEND32;
  999. if RawRecord.RecordLength<2 then
  1000. internalerror(2015040305);
  1001. ModTyp:=RawRecord.RawData[0];
  1002. IsMainModule:=(ModTyp and $80)<>0;
  1003. HasStartAddress:=(ModTyp and $40)<>0;
  1004. SegmentBit:=(ModTyp and $20)<>0;
  1005. LogicalStartAddress:=(ModTyp and $01)<>0;
  1006. if (ModTyp and $1E)<>0 then
  1007. internalerror(2015041404);
  1008. NextOfs:=1;
  1009. { clear all the start address properties first }
  1010. FrameMethod:=Low(FrameMethod);
  1011. FrameDatum:=0;
  1012. TargetMethod:=Low(TargetMethod);
  1013. TargetDatum:=0;
  1014. TargetDisplacement:=0;
  1015. PhysFrameNumber:=0;
  1016. PhysOffset:=0;
  1017. if HasStartAddress then
  1018. begin
  1019. if LogicalStartAddress then
  1020. begin
  1021. if NextOfs>=RawRecord.RecordLength then
  1022. internalerror(2015040305);
  1023. EndData:=RawRecord.RawData[NextOfs];
  1024. Inc(NextOfs);
  1025. { frame and target method determined by thread is not allowed in MODEND records }
  1026. if (EndData and $88)<>0 then
  1027. internalerror(2015041406);
  1028. FrameMethod:=TOmfFixupFrameMethod((EndData shr 4) and 7);
  1029. TargetMethod:=TOmfFixupTargetMethod(EndData and 7);
  1030. { frame method ffmLocation is not allowed in an MODEND record }
  1031. if FrameMethod=ffmLocation then
  1032. internalerror(2015041402);
  1033. { read Frame Datum? }
  1034. if FrameMethod in [ffmSegmentIndex,ffmGroupIndex,ffmExternalIndex,ffmFrameNumber] then
  1035. NextOfs:=RawRecord.ReadIndexedRef(NextOfs,FFrameDatum);
  1036. { read Target Datum? }
  1037. NextOfs:=RawRecord.ReadIndexedRef(NextOfs,FTargetDatum);
  1038. { read Target Displacement? }
  1039. if TargetMethod in [ftmSegmentIndex,ftmGroupIndex,ftmExternalIndex,ftmFrameNumber] then
  1040. begin
  1041. if Is32Bit then
  1042. begin
  1043. if (NextOfs+3)>=RawRecord.RecordLength then
  1044. internalerror(2015040504);
  1045. TargetDisplacement := RawRecord.RawData[NextOfs]+
  1046. (RawRecord.RawData[NextOfs+1] shl 8)+
  1047. (RawRecord.RawData[NextOfs+2] shl 16)+
  1048. (RawRecord.RawData[NextOfs+3] shl 24);
  1049. Inc(NextOfs,4);
  1050. end
  1051. else
  1052. begin
  1053. if (NextOfs+1)>=RawRecord.RecordLength then
  1054. internalerror(2015040504);
  1055. TargetDisplacement := RawRecord.RawData[NextOfs]+
  1056. (RawRecord.RawData[NextOfs+1] shl 8);
  1057. Inc(NextOfs,2);
  1058. end;
  1059. end;
  1060. end
  1061. else
  1062. begin
  1063. { physical start address }
  1064. if (NextOfs+1)>=RawRecord.RecordLength then
  1065. internalerror(2015040305);
  1066. PhysFrameNumber:=RawRecord.RawData[NextOfs]+(RawRecord.RawData[NextOfs+1] shl 8);
  1067. Inc(NextOfs,2);
  1068. if Is32Bit then
  1069. begin
  1070. if (NextOfs+3)>=RawRecord.RecordLength then
  1071. internalerror(2015040305);
  1072. PhysOffset:=RawRecord.RawData[NextOfs]+(RawRecord.RawData[NextOfs+1] shl 8)+
  1073. (RawRecord.RawData[NextOfs+2] shl 16)+(RawRecord.RawData[NextOfs+3] shl 24);
  1074. Inc(NextOfs,4);
  1075. end
  1076. else
  1077. begin
  1078. if (NextOfs+1)>=RawRecord.RecordLength then
  1079. internalerror(2015040305);
  1080. PhysOffset:=RawRecord.RawData[NextOfs]+(RawRecord.RawData[NextOfs+1] shl 8);
  1081. Inc(NextOfs,2);
  1082. end;
  1083. end;
  1084. end;
  1085. end;
  1086. procedure TOmfRecord_MODEND.EncodeTo(RawRecord: TOmfRawRecord);
  1087. var
  1088. ModTyp: Byte;
  1089. NextOfs: Integer;
  1090. EndData: Byte;
  1091. begin
  1092. if Is32Bit then
  1093. RawRecord.RecordType:=RT_MODEND32
  1094. else
  1095. RawRecord.RecordType:=RT_MODEND;
  1096. ModTyp:=(Ord(IsMainModule) shl 7)+(Ord(HasStartAddress) shl 6)+(Ord(SegmentBit) shl 5)+Ord(LogicalStartAddress);
  1097. RawRecord.RawData[0]:=ModTyp;
  1098. NextOfs:=1;
  1099. if HasStartAddress then
  1100. begin
  1101. if LogicalStartAddress then
  1102. begin
  1103. { frame method ffmLocation is not allowed in an MODEND record }
  1104. if FrameMethod=ffmLocation then
  1105. internalerror(2015041402);
  1106. EndData:=(Ord(FrameMethod) shl 4)+Ord(TargetMethod);
  1107. RawRecord.RawData[NextOfs]:=EndData;
  1108. Inc(NextOfs);
  1109. { save Frame Datum? }
  1110. if FrameMethod in [ffmSegmentIndex,ffmGroupIndex,ffmExternalIndex,ffmFrameNumber] then
  1111. NextOfs:=RawRecord.WriteIndexedRef(NextOfs,FrameDatum);
  1112. { save Target Datum? }
  1113. NextOfs:=RawRecord.WriteIndexedRef(NextOfs,TargetDatum);
  1114. { save Target Displacement? }
  1115. if TargetMethod in [ftmSegmentIndex,ftmGroupIndex,ftmExternalIndex,ftmFrameNumber] then
  1116. begin
  1117. if Is32Bit then
  1118. begin
  1119. RawRecord.RawData[NextOfs]:=Byte(TargetDisplacement);
  1120. RawRecord.RawData[NextOfs+1]:=Byte(TargetDisplacement shr 8);
  1121. RawRecord.RawData[NextOfs+2]:=Byte(TargetDisplacement shr 16);
  1122. RawRecord.RawData[NextOfs+3]:=Byte(TargetDisplacement shr 24);
  1123. Inc(NextOfs,4);
  1124. end
  1125. else
  1126. begin
  1127. if TargetDisplacement>$ffff then
  1128. internalerror(2015040502);
  1129. RawRecord.RawData[NextOfs]:=Byte(TargetDisplacement);
  1130. RawRecord.RawData[NextOfs+1]:=Byte(TargetDisplacement shr 8);
  1131. Inc(NextOfs,2);
  1132. end;
  1133. end;
  1134. end
  1135. else
  1136. begin
  1137. { physical start address }
  1138. RawRecord.RawData[NextOfs]:=Byte(PhysFrameNumber);
  1139. RawRecord.RawData[NextOfs+1]:=Byte(PhysFrameNumber shr 8);
  1140. Inc(NextOfs,2);
  1141. if Is32Bit then
  1142. begin
  1143. RawRecord.RawData[NextOfs]:=Byte(PhysOffset);
  1144. RawRecord.RawData[NextOfs+1]:=Byte(PhysOffset shr 8);
  1145. RawRecord.RawData[NextOfs+2]:=Byte(PhysOffset shr 16);
  1146. RawRecord.RawData[NextOfs+3]:=Byte(PhysOffset shr 24);
  1147. Inc(NextOfs,4);
  1148. end
  1149. else
  1150. begin
  1151. if PhysOffset>$ffff then
  1152. internalerror(2015040502);
  1153. RawRecord.RawData[NextOfs]:=Byte(PhysOffset);
  1154. RawRecord.RawData[NextOfs+1]:=Byte(PhysOffset shr 8);
  1155. Inc(NextOfs,2);
  1156. end;
  1157. end;
  1158. end;
  1159. RawRecord.RecordLength:=NextOfs+1;
  1160. RawRecord.CalculateChecksumByte;
  1161. end;
  1162. { TOmfSubRecord_FIXUP }
  1163. function TOmfSubRecord_FIXUP.GetDataRecordOffset: Integer;
  1164. begin
  1165. Result:=FLocationOffset-FDataRecordStartOffset;
  1166. end;
  1167. procedure TOmfSubRecord_FIXUP.SetDataRecordOffset(AValue: Integer);
  1168. begin
  1169. FLocationOffset:=AValue+FDataRecordStartOffset;
  1170. end;
  1171. function TOmfSubRecord_FIXUP.ReadAt(RawRecord: TOmfRawRecord; Offset: Integer): Integer;
  1172. var
  1173. Locat: Word;
  1174. FixData: Byte;
  1175. begin
  1176. if (Offset+2)>=RawRecord.RecordLength then
  1177. internalerror(2015040504);
  1178. { unlike other fields in the OMF format, this one is big endian }
  1179. Locat:=(RawRecord.RawData[Offset] shl 8) or RawRecord.RawData[Offset+1];
  1180. FixData:=RawRecord.RawData[Offset+2];
  1181. Inc(Offset,3);
  1182. if (Locat and $8000)=0 then
  1183. internalerror(2015040503);
  1184. DataRecordOffset:=Locat and $3FF;
  1185. LocationType:=TOmfFixupLocationType((Locat shr 10) and 15);
  1186. Mode:=TOmfFixupMode((Locat shr 14) and 1);
  1187. FrameDeterminedByThread:=(FixData and $80)<>0;
  1188. TargetDeterminedByThread:=(FixData and $08)<>0;
  1189. if FrameDeterminedByThread then
  1190. FrameThread:=TOmfFixupThread((FixData shr 4) and 3)
  1191. else
  1192. FrameMethod:=TOmfFixupFrameMethod((FixData shr 4) and 7);
  1193. if TargetDeterminedByThread then
  1194. begin
  1195. TargetThread:=TOmfFixupThread(FixData and 3);
  1196. TargetThreadDisplacementPresent:=(FixData and $40)=0;
  1197. end
  1198. else
  1199. TargetMethod:=TOmfFixupTargetMethod(FixData and 7);
  1200. { read Frame Datum? }
  1201. if not FrameDeterminedByThread and (FrameMethod in [ffmSegmentIndex,ffmGroupIndex,ffmExternalIndex,ffmFrameNumber]) then
  1202. Offset:=RawRecord.ReadIndexedRef(Offset,FFrameDatum)
  1203. else
  1204. FrameDatum:=0;
  1205. { read Target Datum? }
  1206. if not TargetDeterminedByThread then
  1207. Offset:=RawRecord.ReadIndexedRef(Offset,FTargetDatum)
  1208. else
  1209. TargetDatum:=0;
  1210. { read Target Displacement? }
  1211. if (TargetDeterminedByThread and TargetThreadDisplacementPresent) or
  1212. (TargetMethod in [ftmSegmentIndex,ftmGroupIndex,ftmExternalIndex,ftmFrameNumber]) then
  1213. begin
  1214. if Is32Bit then
  1215. begin
  1216. if (Offset+3)>=RawRecord.RecordLength then
  1217. internalerror(2015040504);
  1218. TargetDisplacement := RawRecord.RawData[Offset]+
  1219. (RawRecord.RawData[Offset+1] shl 8)+
  1220. (RawRecord.RawData[Offset+2] shl 16)+
  1221. (RawRecord.RawData[Offset+3] shl 24);
  1222. Inc(Offset,4);
  1223. end
  1224. else
  1225. begin
  1226. if (Offset+1)>=RawRecord.RecordLength then
  1227. internalerror(2015040504);
  1228. TargetDisplacement := RawRecord.RawData[Offset]+
  1229. (RawRecord.RawData[Offset+1] shl 8);
  1230. Inc(Offset,2);
  1231. end;
  1232. end;
  1233. Result:=Offset;
  1234. end;
  1235. function TOmfSubRecord_FIXUP.WriteAt(RawRecord: TOmfRawRecord; Offset: Integer): Integer;
  1236. var
  1237. Locat: Word;
  1238. FixData: Byte;
  1239. begin
  1240. if (DataRecordOffset<0) or (DataRecordOffset>1023) then
  1241. internalerror(2015040501);
  1242. Locat:=$8000+(Ord(Mode) shl 14)+(Ord(LocationType) shl 10)+DataRecordOffset;
  1243. { unlike other fields in the OMF format, this one is big endian }
  1244. RawRecord.RawData[Offset]:=Byte(Locat shr 8);
  1245. RawRecord.RawData[Offset+1]:=Byte(Locat);
  1246. Inc(Offset, 2);
  1247. FixData:=(Ord(FrameDeterminedByThread) shl 7)+(Ord(TargetDeterminedByThread) shl 3);
  1248. if FrameDeterminedByThread then
  1249. FixData:=FixData+(Ord(FrameThread) shl 4)
  1250. else
  1251. FixData:=FixData+(Ord(FrameMethod) shl 4);
  1252. if TargetDeterminedByThread then
  1253. FixData:=FixData+Ord(TargetThread)+(Ord(not TargetThreadDisplacementPresent) shl 2)
  1254. else
  1255. FixData:=FixData+Ord(TargetMethod);
  1256. RawRecord.RawData[Offset]:=FixData;
  1257. Inc(Offset);
  1258. { save Frame Datum? }
  1259. if not FrameDeterminedByThread and (FrameMethod in [ffmSegmentIndex,ffmGroupIndex,ffmExternalIndex,ffmFrameNumber]) then
  1260. Offset:=RawRecord.WriteIndexedRef(Offset,FrameDatum);
  1261. { save Target Datum? }
  1262. if not TargetDeterminedByThread then
  1263. Offset:=RawRecord.WriteIndexedRef(Offset,TargetDatum);
  1264. { save Target Displacement? }
  1265. if (TargetDeterminedByThread and TargetThreadDisplacementPresent) or
  1266. (TargetMethod in [ftmSegmentIndex,ftmGroupIndex,ftmExternalIndex,ftmFrameNumber]) then
  1267. begin
  1268. if Is32Bit then
  1269. begin
  1270. RawRecord.RawData[Offset]:=Byte(TargetDisplacement);
  1271. RawRecord.RawData[Offset+1]:=Byte(TargetDisplacement shr 8);
  1272. RawRecord.RawData[Offset+2]:=Byte(TargetDisplacement shr 16);
  1273. RawRecord.RawData[Offset+3]:=Byte(TargetDisplacement shr 24);
  1274. Inc(Offset,4);
  1275. end
  1276. else
  1277. begin
  1278. if TargetDisplacement>$ffff then
  1279. internalerror(2015040502);
  1280. RawRecord.RawData[Offset]:=Byte(TargetDisplacement);
  1281. RawRecord.RawData[Offset+1]:=Byte(TargetDisplacement shr 8);
  1282. Inc(Offset,2);
  1283. end;
  1284. end;
  1285. Result:=Offset;
  1286. end;
  1287. { TOmfRecord_LIBHEAD }
  1288. constructor TOmfRecord_LIBHEAD.Create;
  1289. begin
  1290. PageSize:=512;
  1291. DictionarySizeInBlocks:=2;
  1292. CaseSensitive:=true;
  1293. end;
  1294. procedure TOmfRecord_LIBHEAD.SetPageSize(AValue: Integer);
  1295. var
  1296. p: longint;
  1297. begin
  1298. { valid library page sizes are powers of two, between 2**4 and 2**15 }
  1299. if not ispowerof2(AValue,p) then
  1300. internalerror(2015041802);
  1301. if (p<4) or (p>15) then
  1302. internalerror(2015041802);
  1303. FPageSize:=AValue;
  1304. end;
  1305. procedure TOmfRecord_LIBHEAD.DecodeFrom(RawRecord: TOmfRawRecord);
  1306. begin
  1307. if RawRecord.RecordType<>RT_LIBHEAD then
  1308. internalerror(2015040301);
  1309. { this will also range check PageSize and will ensure that RecordLength>=13 }
  1310. PageSize:=RawRecord.RecordLength+3;
  1311. DictionaryOffset:=RawRecord.RawData[0]+
  1312. (RawRecord.RawData[1] shl 8)+
  1313. (RawRecord.RawData[2] shl 16)+
  1314. (RawRecord.RawData[3] shl 24);
  1315. DictionarySizeInBlocks:=RawRecord.RawData[4]+
  1316. (RawRecord.RawData[5] shl 8);
  1317. Flags:=RawRecord.RawData[6];
  1318. end;
  1319. procedure TOmfRecord_LIBHEAD.EncodeTo(RawRecord: TOmfRawRecord);
  1320. begin
  1321. { make sure the LIBHEAD record is padded with zeros at the end }
  1322. FillChar(RawRecord.RawData,SizeOf(RawRecord.RawData),0);
  1323. RawRecord.RecordType:=RT_LIBHEAD;
  1324. RawRecord.RecordLength:=PageSize-3;
  1325. RawRecord.RawData[0]:=Byte(DictionaryOffset);
  1326. RawRecord.RawData[1]:=Byte(DictionaryOffset shr 8);
  1327. RawRecord.RawData[2]:=Byte(DictionaryOffset shr 16);
  1328. RawRecord.RawData[3]:=Byte(DictionaryOffset shr 24);
  1329. RawRecord.RawData[4]:=Byte(DictionarySizeInBlocks);
  1330. RawRecord.RawData[5]:=Byte(DictionarySizeInBlocks shr 8);
  1331. RawRecord.RawData[6]:=Flags;
  1332. { the LIBHEAD record contains no checksum byte, so no need to call
  1333. RawRecord.CalculateChecksumByte }
  1334. end;
  1335. function TOmfRecord_LIBHEAD.IsCaseSensitive: Boolean;
  1336. begin
  1337. Result:=(FFlags and 1)<>0;
  1338. end;
  1339. procedure TOmfRecord_LIBHEAD.SetCaseSensitive(AValue: Boolean);
  1340. begin
  1341. FFlags:=(FFlags and $FE) or Ord(AValue);
  1342. end;
  1343. function compute_omf_lib_hash(const name: string; blocks: Integer): TOmfLibHash;
  1344. const
  1345. blank=$20; // ASCII blank
  1346. nbuckets=37;
  1347. var
  1348. block_x: Integer;
  1349. block_d: Integer;
  1350. bucket_x: Integer;
  1351. bucket_d: Integer;
  1352. len: Integer;
  1353. pbidx,peidx: Integer;
  1354. cback,cfront: Byte;
  1355. begin
  1356. len:=Length(name);
  1357. if len=0 then
  1358. internalerror(2015041801);
  1359. pbidx:=1;
  1360. peidx:=len+1;
  1361. { left to right scan }
  1362. block_x:=len or blank;
  1363. bucket_d:=block_x;
  1364. { right to left scan }
  1365. block_d:=0;
  1366. bucket_x:=0;
  1367. while true do
  1368. begin
  1369. { blank -> convert to LC }
  1370. Dec(peidx);
  1371. cback:=Byte(name[peidx]) or blank;
  1372. bucket_x:=RorWord(bucket_x,2) xor cback;
  1373. block_d:=RolWord(block_d,2) xor cback;
  1374. Dec(len);
  1375. if len=0 then
  1376. break;
  1377. cfront:=Byte(name[pbidx]) or blank;
  1378. Inc(pbidx);
  1379. block_x:=RolWord(block_x,2) xor cfront;
  1380. bucket_d:=RorWord(bucket_d,2) xor cfront;
  1381. end;
  1382. Result.block_x:=block_x mod blocks;
  1383. Result.block_d:=max(block_d mod blocks,1);
  1384. Result.bucket_x:=bucket_x mod nbuckets;
  1385. Result.bucket_d:=max(bucket_d mod nbuckets,1);
  1386. end;
  1387. end.