omfbase.pas 25 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735
  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. { OMF comment class }
  67. CC_Translator = $00; { language translator (compiler or assembler) name }
  68. CC_IntelCopyright = $01;
  69. CC_IntelReservedRangeStart = $02;
  70. CC_IntelReservedRangeEnd = $9B;
  71. CC_LibrarySpecifierObsolete = $81;
  72. CC_MsDosVersionObsolete = $9C;
  73. CC_MemoryModel = $9D;
  74. CC_DOSSEG = $9E;
  75. CC_DefaultLibrarySearchName = $9F;
  76. CC_OmfExtension = $A0;
  77. CC_NewOmfExtension = $A1;
  78. CC_LinkPassSeparator = $A2;
  79. CC_LIBMOD = $A3;
  80. CC_EXESTR = $A4;
  81. CC_INCERR = $A6;
  82. CC_NOPAD = $A7;
  83. CC_WKEXT = $A8;
  84. CC_LZEXT = $A9;
  85. CC_Comment = $DA;
  86. CC_Compiler = $DB;
  87. CC_Date = $DC;
  88. CC_Timestamp = $DD;
  89. CC_User = $DF;
  90. CC_DependencyFileBorland = $E9;
  91. CC_CommandLineMicrosoft = $FF;
  92. type
  93. TOmfSegmentAlignment = (
  94. saAbsolute = 0,
  95. saRelocatableByteAligned = 1,
  96. saRelocatableWordAligned = 2,
  97. saRelocatableParaAligned = 3,
  98. saRelocatablePageAligned = 4, { 32-bit linkers extension }
  99. saRelocatableDWordAligned = 5, { 32-bit linkers extension }
  100. saNotSupported = 6,
  101. saNotDefined = 7);
  102. TOmfSegmentCombination = (
  103. scPrivate = 0,
  104. scReserved1 = 1,
  105. scPublic = 2,
  106. scReserved3 = 3,
  107. scPublic4 = 4, { same as scPublic }
  108. scStack = 5,
  109. scCommon = 6,
  110. scPublic7 = 7); { same as scPublic }
  111. TOmfSegmentUse = (suUse16, suUse32);
  112. TOmfFixupMode = (fmSelfRelative, fmSegmentRelative);
  113. TOmfFixupLocationType = (
  114. fltLoByte = 0, { low 8 bits of 16-bit offset }
  115. fltOffset = 1, { 16-bit offset }
  116. fltBase = 2, { 16-bit base (segment) }
  117. fltFarPointer = 3, { 16-bit base:16-bit offset }
  118. fltHiByte = 4, { high 8 bits of 16-bit offset }
  119. fltLoaderResolvedOffset = 5, { PharLap: Offset32 }
  120. fltUndefined6 = 6, { PharLap: Pointer48 }
  121. fltUndefined7 = 7,
  122. fltUndefined8 = 8,
  123. fltOffset32 = 9, { 32-bit offset }
  124. fltUndefined10 = 10,
  125. fltFarPointer48 = 11, { 16-bit base:32-bit offset }
  126. fltUndefined12 = 12,
  127. fltLoaderResolvedOffset32 = 13,
  128. fltUndefined14 = 14,
  129. fltUndefined15 = 15);
  130. TOmfFixupFrameMethod = (
  131. ffmSegmentIndex = 0, { SI(<segment name>) - The frame is the canonic frame of the logical
  132. segment segment defined by the index }
  133. ffmGroupIndex = 1, { GI(<group name>) - The frame is the canonic frame of the group
  134. (= the canonic frame of the logical segment from the group,
  135. located at the lowest memory address) }
  136. ffmExternalIndex = 2, { EI(<symbol name>) - The frame is determined depending on the external's public definition:
  137. * if the symbol is defined relative to a logical segment and no defined group,
  138. the frame of the logical segment is used
  139. * if the symbol is defined absolutely, without reference to a logical segment and
  140. no defined group, the FRAME NUMBER from the symbol's PUBDEF record is used
  141. * regardless of how the symbol is specified, if there's an associated group,
  142. that group's canonic frame is used }
  143. ffmFrameNumber = 3, { <FRAME NUMBER> - The frame is a directly specified constant. }
  144. ffmLocation = 4, { LOCATION - The frame is determined by the location (i.e. the canonic frame of the logical
  145. segment where the fixup location is) }
  146. ffmTarget = 5, { TARGET - The frame is determined by the target. }
  147. ffmNone = 6, { NONE - There is no frame. Used for 8089 self-relative references. }
  148. ffmUndefined = 7);
  149. TOmfFixupTargetMethod = (
  150. ftmSegmentIndex = 0, { SI(<segment name>),<displacement> }
  151. ftmGroupIndex = 1, { GI(<group name>),<displacement> }
  152. ftmExternalIndex = 2, { EI(<symbol name>),<displacement> }
  153. ftmFrameNumber = 3, { <FRAME NUMBER>,<displacement> }
  154. ftmSegmentIndexNoDisp = 4, { SI(<segment name>) }
  155. ftmGroupIndexNoDisp = 5, { GI(<group name>) }
  156. ftmExternalIndexNoDisp = 6, { EI(<symbol name>) }
  157. ftmFrameNumberNoDisp = 7); { <FRAME NUMBER> }
  158. { TOmfOrderedNameCollection }
  159. TOmfOrderedNameCollection = class
  160. private
  161. FStringList: array of string;
  162. function GetCount: Integer;
  163. function GetString(Index: Integer): string;
  164. procedure SetString(Index: Integer; AValue: string);
  165. public
  166. function Add(const S: string): Integer;
  167. procedure Clear;
  168. property Strings [Index: Integer]: string read GetString write SetString; default;
  169. property Count: Integer read GetCount;
  170. end;
  171. { TOmfRawRecord }
  172. TOmfRawRecord = class
  173. private
  174. function GetChecksumByte: Byte;
  175. function GetRecordLength: Word;
  176. function GetRecordType: Byte;
  177. procedure SetChecksumByte(AValue: Byte);
  178. procedure SetRecordLength(AValue: Word);
  179. procedure SetRecordType(AValue: Byte);
  180. public
  181. RawData: array [-3..65535] of Byte;
  182. property RecordType: Byte read GetRecordType write SetRecordType;
  183. property RecordLength: Word read GetRecordLength write SetRecordLength;
  184. function ReadStringAt(Offset: Integer; out s: string): Integer;
  185. function WriteStringAt(Offset: Integer; s: string): Integer;
  186. function ReadIndexedRef(Offset: Integer; out IndexedRef: Integer): Integer;
  187. function WriteIndexedRef(Offset: Integer; IndexedRef: Integer): Integer;
  188. procedure CalculateChecksumByte;
  189. function VerifyChecksumByte: boolean;
  190. property ChecksumByte: Byte read GetChecksumByte write SetChecksumByte;
  191. procedure ReadFrom(aReader: TObjectReader);
  192. procedure WriteTo(aWriter: TObjectWriter);
  193. end;
  194. { TOmfParsedRecord }
  195. TOmfParsedRecord = class
  196. public
  197. procedure DecodeFrom(RawRecord: TOmfRawRecord);virtual;abstract;
  198. procedure EncodeTo(RawRecord: TOmfRawRecord);virtual;abstract;
  199. end;
  200. { TOmfRecord_THEADR }
  201. TOmfRecord_THEADR = class(TOmfParsedRecord)
  202. private
  203. FModuleName: string;
  204. public
  205. procedure DecodeFrom(RawRecord: TOmfRawRecord);override;
  206. procedure EncodeTo(RawRecord: TOmfRawRecord);override;
  207. property ModuleName: string read FModuleName write FModuleName;
  208. end;
  209. { TOmfRecord_COMENT }
  210. TOmfRecord_COMENT = class(TOmfParsedRecord)
  211. private
  212. FCommentType: Byte;
  213. FCommentClass: Byte;
  214. FCommentString: string;
  215. function GetNoList: Boolean;
  216. function GetNoPurge: Boolean;
  217. procedure SetNoList(AValue: Boolean);
  218. procedure SetNoPurge(AValue: Boolean);
  219. public
  220. procedure DecodeFrom(RawRecord: TOmfRawRecord);override;
  221. procedure EncodeTo(RawRecord: TOmfRawRecord);override;
  222. property CommentType: Byte read FCommentType write FCommentType;
  223. property CommentClass: Byte read FCommentClass write FCommentClass;
  224. property CommentString: string read FCommentString write FCommentString;
  225. property NoPurge: Boolean read GetNoPurge write SetNoPurge;
  226. property NoList: Boolean read GetNoList write SetNoList;
  227. end;
  228. { TOmfRecord_LNAMES }
  229. TOmfRecord_LNAMES = class(TOmfParsedRecord)
  230. private
  231. FNames: TOmfOrderedNameCollection;
  232. FNextIndex: Integer;
  233. public
  234. constructor Create;
  235. procedure DecodeFrom(RawRecord: TOmfRawRecord);override;
  236. procedure EncodeTo(RawRecord: TOmfRawRecord);override;
  237. property Names: TOmfOrderedNameCollection read FNames write FNames;
  238. property NextIndex: Integer read FNextIndex write FNextIndex;
  239. end;
  240. { TOmfRecord_SEGDEF }
  241. TOmfRecord_SEGDEF = class(TOmfParsedRecord)
  242. private
  243. FAlignment: TOmfSegmentAlignment;
  244. FCombination: TOmfSegmentCombination;
  245. FUse: TOmfSegmentUse;
  246. FFrameNumber: Word;
  247. FOffset: Byte;
  248. FIs32Bit: Boolean;
  249. FSegmentLength: Int64; { int64, because it can be 2**32 }
  250. FSegmentNameIndex: Integer;
  251. FClassNameIndex: Integer;
  252. FOverlayNameIndex: Integer;
  253. public
  254. procedure DecodeFrom(RawRecord: TOmfRawRecord);override;
  255. procedure EncodeTo(RawRecord: TOmfRawRecord);override;
  256. property Alignment: TOmfSegmentAlignment read FAlignment write FAlignment;
  257. property Combination: TOmfSegmentCombination read FCombination write FCombination;
  258. property Use: TOmfSegmentUse read FUse write FUse;
  259. property FrameNumber: Word read FFrameNumber write FFrameNumber;
  260. property Offset: Byte read FOffset write FOffset;
  261. property Is32Bit: Boolean read FIs32Bit write FIs32Bit;
  262. property SegmentLength: Int64 read FSegmentLength write FSegmentLength;
  263. property SegmentNameIndex: Integer read FSegmentNameIndex write FSegmentNameIndex;
  264. property ClassNameIndex: Integer read FClassNameIndex write FClassNameIndex;
  265. property OverlayNameIndex: Integer read FOverlayNameIndex write FOverlayNameIndex;
  266. end;
  267. TSegmentList = array of Integer;
  268. { TOmfRecord_GRPDEF }
  269. TOmfRecord_GRPDEF = class(TOmfParsedRecord)
  270. private
  271. FGroupNameIndex: Integer;
  272. FSegmentList: TSegmentList;
  273. public
  274. procedure DecodeFrom(RawRecord: TOmfRawRecord);override;
  275. procedure EncodeTo(RawRecord: TOmfRawRecord);override;
  276. property GroupNameIndex: Integer read FGroupNameIndex write FGroupNameIndex;
  277. property SegmentList: TSegmentList read FSegmentList write FSegmentList;
  278. end;
  279. implementation
  280. uses
  281. verbose;
  282. { TOmfOrderedNameCollection }
  283. function TOmfOrderedNameCollection.GetString(Index: Integer): string;
  284. begin
  285. Result:=FStringList[Index-1];
  286. end;
  287. function TOmfOrderedNameCollection.GetCount: Integer;
  288. begin
  289. Result:=Length(FStringList);
  290. end;
  291. procedure TOmfOrderedNameCollection.SetString(Index: Integer; AValue: string);
  292. begin
  293. FStringList[Index-1]:=AValue;
  294. end;
  295. function TOmfOrderedNameCollection.Add(const S: string): Integer;
  296. begin
  297. Result:=Length(FStringList)+1;
  298. SetLength(FStringList,Result);
  299. FStringList[Result-1]:=S;
  300. end;
  301. procedure TOmfOrderedNameCollection.Clear;
  302. begin
  303. SetLength(FStringList,0);
  304. end;
  305. { TOmfRawRecord }
  306. function TOmfRawRecord.GetRecordType: Byte;
  307. begin
  308. Result:=RawData[-3];
  309. end;
  310. procedure TOmfRawRecord.SetRecordType(AValue: Byte);
  311. begin
  312. RawData[-3]:=AValue;
  313. end;
  314. function TOmfRawRecord.GetRecordLength: Word;
  315. begin
  316. Result:=RawData[-2] or (RawData[-1] shl 8);
  317. end;
  318. procedure TOmfRawRecord.SetRecordLength(AValue: Word);
  319. begin
  320. RawData[-2]:=Byte(AValue);
  321. RawData[-1]:=Byte(AValue shr 8);
  322. end;
  323. function TOmfRawRecord.ReadStringAt(Offset: Integer; out s: string): Integer;
  324. var
  325. len: Byte;
  326. begin
  327. len:=RawData[Offset];
  328. Result:=Offset+len+1;
  329. if result>RecordLength then
  330. internalerror(2015033103);
  331. SetLength(s, len);
  332. UniqueString(s);
  333. Move(RawData[Offset+1],s[1],len);
  334. end;
  335. function TOmfRawRecord.WriteStringAt(Offset: Integer; s: string): Integer;
  336. begin
  337. if Length(s)>255 then
  338. internalerror(2015033101);
  339. result:=Offset+Length(s)+1;
  340. if result>High(RawData) then
  341. internalerror(2015033102);
  342. RawData[Offset]:=Length(s);
  343. Move(s[1], RawData[Offset+1], Length(s));
  344. end;
  345. function TOmfRawRecord.ReadIndexedRef(Offset: Integer; out IndexedRef: Integer): Integer;
  346. begin
  347. Result:=Offset+1;
  348. if result>RecordLength then
  349. internalerror(2015033103);
  350. IndexedRef:=RawData[Offset];
  351. if IndexedRef<=$7f then
  352. exit;
  353. Result:=Offset+2;
  354. if result>RecordLength then
  355. internalerror(2015033103);
  356. IndexedRef:=((IndexedRef and $7f) shl 8)+RawData[Offset+1];
  357. end;
  358. function TOmfRawRecord.WriteIndexedRef(Offset: Integer; IndexedRef: Integer): Integer;
  359. begin
  360. if (IndexedRef<0) or (IndexedRef>$7FFF) then
  361. internalerror(2015040303);
  362. if IndexedRef<=$7f then
  363. begin
  364. Result:=Offset+1;
  365. if Result>High(RawData) then
  366. internalerror(2015033102);
  367. RawData[Offset]:=IndexedRef;
  368. end
  369. else
  370. begin
  371. Result:=Offset+2;
  372. if Result>High(RawData) then
  373. internalerror(2015033102);
  374. RawData[Offset]:=$80+(IndexedRef shr 8);
  375. RawData[Offset+1]:=Byte(IndexedRef);
  376. end;
  377. end;
  378. function TOmfRawRecord.GetChecksumByte: Byte;
  379. begin
  380. if RecordLength>0 then
  381. Result:=RawData[RecordLength-1]
  382. else
  383. Result:=0;
  384. end;
  385. procedure TOmfRawRecord.SetChecksumByte(AValue: Byte);
  386. begin
  387. if RecordLength>0 then
  388. RawData[RecordLength-1]:=AValue;
  389. end;
  390. procedure TOmfRawRecord.CalculateChecksumByte;
  391. var
  392. I: Integer;
  393. b: Byte;
  394. begin
  395. b:=0;
  396. for I:=-3 to RecordLength-2 do
  397. b:=byte(b+RawData[I]);
  398. SetChecksumByte($100-b);
  399. end;
  400. function TOmfRawRecord.VerifyChecksumByte: boolean;
  401. var
  402. I: Integer;
  403. b: Byte;
  404. begin
  405. { according to the OMF spec, some tools always write a 0 rather than
  406. computing the checksum, so it should also be accepted as correct }
  407. if ChecksumByte=0 then
  408. exit(true);
  409. b:=0;
  410. for I:=-3 to RecordLength-1 do
  411. b:=byte(b+RawData[I]);
  412. Result:=(b=0);
  413. end;
  414. procedure TOmfRawRecord.ReadFrom(aReader: TObjectReader);
  415. begin
  416. aReader.read(RawData, 3);
  417. aReader.read(RawData[0], RecordLength);
  418. end;
  419. procedure TOmfRawRecord.WriteTo(aWriter: TObjectWriter);
  420. begin
  421. aWriter.write(RawData, RecordLength+3);
  422. end;
  423. { TOmfRecord_THEADR }
  424. procedure TOmfRecord_THEADR.DecodeFrom(RawRecord: TOmfRawRecord);
  425. begin
  426. RawRecord.ReadStringAt(0,FModuleName);
  427. end;
  428. procedure TOmfRecord_THEADR.EncodeTo(RawRecord: TOmfRawRecord);
  429. var
  430. NextOfs: Integer;
  431. begin
  432. RawRecord.RecordType:=RT_THEADR;
  433. NextOfs:=RawRecord.WriteStringAt(0,ModuleName);
  434. RawRecord.RecordLength:=NextOfs+1;
  435. RawRecord.CalculateChecksumByte;
  436. end;
  437. { TOmfRecord_COMENT }
  438. function TOmfRecord_COMENT.GetNoList: Boolean;
  439. begin
  440. Result:=(CommentType and $40)<>0;
  441. end;
  442. function TOmfRecord_COMENT.GetNoPurge: Boolean;
  443. begin
  444. Result:=(CommentType and $80)<>0;
  445. end;
  446. procedure TOmfRecord_COMENT.SetNoList(AValue: Boolean);
  447. begin
  448. if AValue then
  449. CommentType:=CommentType or $40
  450. else
  451. CommentType:=CommentType and $BF;
  452. end;
  453. procedure TOmfRecord_COMENT.SetNoPurge(AValue: Boolean);
  454. begin
  455. if AValue then
  456. CommentType:=CommentType or $80
  457. else
  458. CommentType:=CommentType and $7F;
  459. end;
  460. procedure TOmfRecord_COMENT.DecodeFrom(RawRecord: TOmfRawRecord);
  461. begin
  462. if RawRecord.RecordLength<3 then
  463. internalerror(2015033104);
  464. CommentType:=RawRecord.RawData[0];
  465. CommentClass:=RawRecord.RawData[1];
  466. SetLength(FCommentString,RawRecord.RecordLength-3);
  467. UniqueString(FCommentString);
  468. Move(RawRecord.RawData[2],FCommentString[1],Length(FCommentString));
  469. end;
  470. procedure TOmfRecord_COMENT.EncodeTo(RawRecord: TOmfRawRecord);
  471. begin
  472. RawRecord.RecordType:=RT_COMENT;
  473. if (Length(FCommentString)+3)>High(RawRecord.RawData) then
  474. internalerror(2015033105);
  475. RawRecord.RecordLength:=Length(FCommentString)+3;
  476. RawRecord.RawData[0]:=CommentType;
  477. RawRecord.RawData[1]:=CommentClass;
  478. Move(FCommentString[1],RawRecord.RawData[2],Length(FCommentString));
  479. RawRecord.CalculateChecksumByte;
  480. end;
  481. { TOmfRecord_LNAMES }
  482. constructor TOmfRecord_LNAMES.Create;
  483. begin
  484. FNextIndex:=1;
  485. end;
  486. procedure TOmfRecord_LNAMES.DecodeFrom(RawRecord: TOmfRawRecord);
  487. begin
  488. {TODO: implement}
  489. internalerror(2015040101);
  490. end;
  491. procedure TOmfRecord_LNAMES.EncodeTo(RawRecord: TOmfRawRecord);
  492. const
  493. RecordLengthLimit = 1024;
  494. var
  495. Len,LastIncludedIndex,NextOfs,I: Integer;
  496. begin
  497. RawRecord.RecordType:=RT_LNAMES;
  498. { find out how many strings can we include until we reach the length limit }
  499. Len:=1;
  500. LastIncludedIndex:=NextIndex-1;
  501. repeat
  502. Inc(LastIncludedIndex);
  503. Inc(Len,Length(Names[LastIncludedIndex])+1);
  504. until (LastIncludedIndex>=Names.Count) or ((Len+Length(Names[LastIncludedIndex+1])+1)>=RecordLengthLimit);
  505. { write the strings... }
  506. NextOfs:=0;
  507. for I:=NextIndex to LastIncludedIndex do
  508. NextOfs:=RawRecord.WriteStringAt(NextOfs,Names[I]);
  509. RawRecord.RecordLength:=Len;
  510. RawRecord.CalculateChecksumByte;
  511. { update NextIndex }
  512. NextIndex:=LastIncludedIndex+1;
  513. end;
  514. { TOmfRecord_SEGDEF }
  515. procedure TOmfRecord_SEGDEF.DecodeFrom(RawRecord: TOmfRawRecord);
  516. var
  517. B: Byte;
  518. Big: Boolean;
  519. NextOfs: Integer;
  520. MinLen: Integer;
  521. begin
  522. if not (RawRecord.RecordType in [RT_SEGDEF,RT_SEGDEF32]) then
  523. internalerror(2015040301);
  524. Is32Bit:=RawRecord.RecordType=RT_SEGDEF32;
  525. MinLen:=7; { b(1)+seglength(2..4)+segnameindex(1..2)+classnameindex(1..2)+overlaynameindex(1..2)+checksum }
  526. if Is32Bit then
  527. inc(MinLen,2);
  528. if RawRecord.RecordLength<MinLen then
  529. internalerror(2015040305);
  530. B:=RawRecord.RawData[0];
  531. Alignment:=TOmfSegmentAlignment(B shr 5);
  532. Combination:=TOmfSegmentCombination((B shr 2) and 7);
  533. Big:=(B and 2)<>0;
  534. Use:=TOmfSegmentUse(B and 1);
  535. NextOfs:=1;
  536. if Alignment=saAbsolute then
  537. begin
  538. inc(MinLen,3);
  539. if RawRecord.RecordLength<MinLen then
  540. internalerror(2015040305);
  541. FrameNumber:=RawRecord.RawData[1]+(RawRecord.RawData[2] shl 8);
  542. Offset:=RawRecord.RawData[3];
  543. NextOfs:=4;
  544. end
  545. else
  546. begin
  547. FrameNumber:=0;
  548. Offset:=0;
  549. end;
  550. if Is32Bit then
  551. begin
  552. SegmentLength:=RawRecord.RawData[NextOfs]+
  553. (RawRecord.RawData[NextOfs+1] shl 8)+
  554. (RawRecord.RawData[NextOfs+2] shl 16)+
  555. (RawRecord.RawData[NextOfs+3] shl 24);
  556. if Big then
  557. if SegmentLength=0 then
  558. SegmentLength:=4294967296
  559. else
  560. internalerror(2015040306);
  561. Inc(NextOfs,4);
  562. end
  563. else
  564. begin
  565. SegmentLength:=RawRecord.RawData[NextOfs]+(RawRecord.RawData[NextOfs+1] shl 8);
  566. if Big then
  567. if SegmentLength=0 then
  568. SegmentLength:=65536
  569. else
  570. internalerror(2015040306);
  571. Inc(NextOfs,2);
  572. end;
  573. NextOfs:=RawRecord.ReadIndexedRef(NextOfs,FSegmentNameIndex);
  574. NextOfs:=RawRecord.ReadIndexedRef(NextOfs,FClassNameIndex);
  575. NextOfs:=RawRecord.ReadIndexedRef(NextOfs,FOverlayNameIndex);
  576. end;
  577. procedure TOmfRecord_SEGDEF.EncodeTo(RawRecord: TOmfRawRecord);
  578. var
  579. Big: Boolean;
  580. NextOfs: Integer;
  581. begin
  582. if Is32Bit then
  583. begin
  584. RawRecord.RecordType:=RT_SEGDEF32;
  585. if SegmentLength>4294967296 then
  586. internalerror(2015040302);
  587. Big:=SegmentLength=4294967296;
  588. end
  589. else
  590. begin
  591. RawRecord.RecordType:=RT_SEGDEF;
  592. if SegmentLength>65536 then
  593. internalerror(2015040302);
  594. Big:=SegmentLength=65536;
  595. end;
  596. RawRecord.RawData[0]:=(Ord(Alignment) shl 5) or (Ord(Combination) shl 2) or (Ord(Big) shl 1) or Ord(Use);
  597. NextOfs:=1;
  598. if Alignment=saAbsolute then
  599. begin
  600. RawRecord.RawData[1]:=Byte(FrameNumber);
  601. RawRecord.RawData[2]:=Byte(FrameNumber shr 8);
  602. RawRecord.RawData[3]:=Offset;
  603. NextOfs:=4;
  604. end;
  605. if Is32Bit then
  606. begin
  607. RawRecord.RawData[NextOfs]:=Byte(SegmentLength);
  608. RawRecord.RawData[NextOfs+1]:=Byte(SegmentLength shr 8);
  609. RawRecord.RawData[NextOfs+2]:=Byte(SegmentLength shr 16);
  610. RawRecord.RawData[NextOfs+3]:=Byte(SegmentLength shr 24);
  611. Inc(NextOfs,4);
  612. end
  613. else
  614. begin
  615. RawRecord.RawData[NextOfs]:=Byte(SegmentLength);
  616. RawRecord.RawData[NextOfs+1]:=Byte(SegmentLength shr 8);
  617. Inc(NextOfs,2);
  618. end;
  619. NextOfs:=RawRecord.WriteIndexedRef(NextOfs,SegmentNameIndex);
  620. NextOfs:=RawRecord.WriteIndexedRef(NextOfs,ClassNameIndex);
  621. NextOfs:=RawRecord.WriteIndexedRef(NextOfs,OverlayNameIndex);
  622. RawRecord.RecordLength:=NextOfs+1;
  623. RawRecord.CalculateChecksumByte;
  624. end;
  625. { TOmfRecord_GRPDEF }
  626. procedure TOmfRecord_GRPDEF.DecodeFrom(RawRecord: TOmfRawRecord);
  627. begin
  628. {TODO: implement}
  629. internalerror(2015040101);
  630. end;
  631. procedure TOmfRecord_GRPDEF.EncodeTo(RawRecord: TOmfRawRecord);
  632. var
  633. NextOfs: Integer;
  634. Segment: Integer;
  635. begin
  636. RawRecord.RecordType:=RT_GRPDEF;
  637. NextOfs:=RawRecord.WriteIndexedRef(0,GroupNameIndex);
  638. for Segment in SegmentList do
  639. begin
  640. if NextOfs>High(RawRecord.RawData) then
  641. internalerror(2015040401);
  642. RawRecord.RawData[NextOfs]:=$ff;
  643. NextOfs:=RawRecord.WriteIndexedRef(NextOfs+1,Segment);
  644. end;
  645. RawRecord.RecordLength:=NextOfs+1;
  646. RawRecord.CalculateChecksumByte;
  647. end;
  648. end.