omfbase.pas 59 KB

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