omfbase.pas 57 KB

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