omfbase.pas 58 KB

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