123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632 |
- {
- Copyright (c) 2015 by Nikolay Nikolov
- Contains Relocatable Object Module Format (OMF) definitions
- This is the object format used on the i8086-msdos platform.
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ****************************************************************************
- }
- unit omfbase;
- {$i fpcdefs.inc}
- interface
- {$H+}
- uses
- cclasses,
- owbase;
- const
- { OMF record types }
- RT_THEADR = $80; { Translator Header Record }
- RT_LHEADR = $82; { Library Module Header Record }
- RT_COMENT = $88; { Comment Record }
- RT_MODEND = $8A; { Module End Record }
- RT_MODEND32 = $8B;
- RT_EXTDEF = $8C; { External Names Definition Record }
- RT_PUBDEF = $90; { Public Names Definition Record }
- RT_PUBDEF32 = $91;
- RT_LINNUM = $94; { Line Numbers Record }
- RT_LINNUM32 = $95;
- RT_LNAMES = $96; { List of Names Record }
- RT_SEGDEF = $98; { Segment Definition Record }
- RT_SEGDEF32 = $99;
- RT_GRPDEF = $9A; { Group Definition Record }
- RT_FIXUPP = $9C; { Fixup Record }
- RT_FIXUPP32 = $9D;
- RT_LEDATA = $A0; { Logical Enumerated Data Record }
- RT_LEDATA32 = $A1;
- RT_LIDATA = $A2; { Logical Iterated Data Record }
- RT_LIDATA32 = $A3;
- RT_COMDEF = $B0; { Communal Names Definition Record }
- RT_BAKPAT = $B2; { Backpatch Record }
- RT_BAKPAT32 = $B3;
- RT_LEXTDEF = $B4; { Local External Names Definition Record }
- RT_LEXTDEF32 = $B5;
- RT_LPUBDEF = $B6; { Local Public Names Definition Record }
- RT_LPUBDEF32 = $B7;
- RT_LCOMDEF = $B8; { Local Communal Names Definition Record }
- RT_CEXTDEF = $BC; { COMDAT External Names Definition Record }
- RT_COMDAT = $C2; { Initialized Communal Data Record }
- RT_COMDAT32 = $C3;
- RT_LINSYM = $C4; { Symbol Line Numbers Record }
- RT_LINSYM32 = $C5;
- RT_ALIAS = $C6; { Alias Definition Record }
- RT_NBKPAT = $C8; { Named Backpatch Record }
- RT_NBKPAT32 = $C9;
- RT_LLNAMES = $CA; { Local Logical Names Definition Record }
- RT_VERNUM = $CC; { OMF Version Number Record }
- RT_VENDEXT = $CE; { Vendor-specific OMF Extension Record }
- RT_LIBHEAD = $F0; { Library Header Record }
- RT_LIBEND = $F1; { Library End Record (marks end of objects and beginning of dictionary) }
- { OMF comment class }
- CC_Translator = $00; { language translator (compiler or assembler) name }
- CC_IntelCopyright = $01;
- CC_IntelReservedRangeStart = $02;
- CC_IntelReservedRangeEnd = $9B;
- CC_LibrarySpecifierObsolete = $81;
- CC_MsDosVersionObsolete = $9C;
- CC_MemoryModel = $9D;
- CC_DOSSEG = $9E;
- CC_DefaultLibrarySearchName = $9F;
- CC_OmfExtension = $A0;
- CC_NewOmfExtension = $A1;
- CC_LinkPassSeparator = $A2;
- CC_LIBMOD = $A3;
- CC_EXESTR = $A4;
- CC_INCERR = $A6;
- CC_NOPAD = $A7;
- CC_WKEXT = $A8;
- CC_LZEXT = $A9;
- CC_Comment = $DA;
- CC_Compiler = $DB;
- CC_Date = $DC;
- CC_Timestamp = $DD;
- CC_User = $DF;
- CC_DependencyFileBorland = $E9;
- CC_CommandLineMicrosoft = $FF;
- type
- TOmfSegmentAlignment = (
- saAbsolute = 0,
- saRelocatableByteAligned = 1,
- saRelocatableWordAligned = 2,
- saRelocatableParaAligned = 3,
- saRelocatablePageAligned = 4, { 32-bit linkers extension }
- saRelocatableDWordAligned = 5, { 32-bit linkers extension }
- saNotSupported = 6,
- saNotDefined = 7);
- TOmfSegmentCombination = (
- scPrivate = 0,
- scReserved1 = 1,
- scPublic = 2,
- scReserved3 = 3,
- scPublic4 = 4, { same as scPublic }
- scStack = 5,
- scCommon = 6,
- scPublic7 = 7); { same as scPublic }
- TOmfSegmentUse = (suUse16, suUse32);
- TOmfFixupThread = (ftThread0, ftThread1, ftThread2, ftThread3);
- TOmfFixupMode = (fmSelfRelative, fmSegmentRelative);
- TOmfFixupLocationType = (
- fltLoByte = 0, { low 8 bits of 16-bit offset }
- fltOffset = 1, { 16-bit offset }
- fltBase = 2, { 16-bit base (segment) }
- fltFarPointer = 3, { 16-bit base:16-bit offset }
- fltHiByte = 4, { high 8 bits of 16-bit offset }
- fltLoaderResolvedOffset = 5, { PharLap: Offset32 }
- fltUndefined6 = 6, { PharLap: Pointer48 }
- fltUndefined7 = 7,
- fltUndefined8 = 8,
- fltOffset32 = 9, { 32-bit offset }
- fltUndefined10 = 10,
- fltFarPointer48 = 11, { 16-bit base:32-bit offset }
- fltUndefined12 = 12,
- fltLoaderResolvedOffset32 = 13,
- fltUndefined14 = 14,
- fltUndefined15 = 15);
- TOmfFixupFrameMethod = (
- ffmSegmentIndex = 0, { SI(<segment name>) - The frame is the canonic frame of the logical
- segment segment defined by the index }
- ffmGroupIndex = 1, { GI(<group name>) - The frame is the canonic frame of the group
- (= the canonic frame of the logical segment from the group,
- located at the lowest memory address) }
- ffmExternalIndex = 2, { EI(<symbol name>) - The frame is determined depending on the external's public definition:
- * if the symbol is defined relative to a logical segment and no defined group,
- the frame of the logical segment is used
- * if the symbol is defined absolutely, without reference to a logical segment and
- no defined group, the FRAME NUMBER from the symbol's PUBDEF record is used
- * regardless of how the symbol is specified, if there's an associated group,
- that group's canonic frame is used }
- ffmFrameNumber = 3, { <FRAME NUMBER> - The frame is a directly specified constant. }
- ffmLocation = 4, { LOCATION - The frame is determined by the location (i.e. the canonic frame of the logical
- segment where the fixup location is) }
- ffmTarget = 5, { TARGET - The frame is determined by the target. }
- ffmNone = 6, { NONE - There is no frame. Used for 8089 self-relative references. }
- ffmUndefined = 7);
- TOmfFixupTargetMethod = (
- ftmSegmentIndex = 0, { SI(<segment name>),<displacement> }
- ftmGroupIndex = 1, { GI(<group name>),<displacement> }
- ftmExternalIndex = 2, { EI(<symbol name>),<displacement> }
- ftmFrameNumber = 3, { <FRAME NUMBER>,<displacement> }
- ftmSegmentIndexNoDisp = 4, { SI(<segment name>) }
- ftmGroupIndexNoDisp = 5, { GI(<group name>) }
- ftmExternalIndexNoDisp = 6, { EI(<symbol name>) }
- ftmFrameNumberNoDisp = 7); { <FRAME NUMBER> }
- { TOmfOrderedNameCollection }
- TOmfOrderedNameCollection = class
- private
- FStringList: array of string;
- function GetCount: Integer;
- function GetString(Index: Integer): string;
- procedure SetString(Index: Integer; AValue: string);
- public
- function Add(const S: string): Integer;
- procedure Clear;
- property Strings [Index: Integer]: string read GetString write SetString; default;
- property Count: Integer read GetCount;
- end;
- { TOmfRawRecord }
- TOmfRawRecord = class
- private
- function GetChecksumByte: Byte;
- function GetRecordLength: Word;
- function GetRecordType: Byte;
- procedure SetChecksumByte(AValue: Byte);
- procedure SetRecordLength(AValue: Word);
- procedure SetRecordType(AValue: Byte);
- public
- RawData: array [-3..65535] of Byte;
- property RecordType: Byte read GetRecordType write SetRecordType;
- property RecordLength: Word read GetRecordLength write SetRecordLength;
- function ReadStringAt(Offset: Integer; out s: string): Integer;
- function WriteStringAt(Offset: Integer; s: string): Integer;
- function ReadIndexedRef(Offset: Integer; out IndexedRef: Integer): Integer;
- function WriteIndexedRef(Offset: Integer; IndexedRef: Integer): Integer;
- procedure CalculateChecksumByte;
- function VerifyChecksumByte: boolean;
- property ChecksumByte: Byte read GetChecksumByte write SetChecksumByte;
- procedure ReadFrom(aReader: TObjectReader);
- procedure ReadFrom(aReader: TDynamicArray);
- procedure WriteTo(aWriter: TObjectWriter);
- procedure WriteTo(aWriter: TDynamicArray);
- end;
- { TOmfParsedRecord }
- TOmfParsedRecord = class
- public
- procedure DecodeFrom(RawRecord: TOmfRawRecord);virtual;abstract;
- procedure EncodeTo(RawRecord: TOmfRawRecord);virtual;abstract;
- end;
- { TOmfRecord_THEADR }
- TOmfRecord_THEADR = class(TOmfParsedRecord)
- private
- FModuleName: string;
- public
- procedure DecodeFrom(RawRecord: TOmfRawRecord);override;
- procedure EncodeTo(RawRecord: TOmfRawRecord);override;
- property ModuleName: string read FModuleName write FModuleName;
- end;
- { TOmfRecord_COMENT }
- TOmfRecord_COMENT = class(TOmfParsedRecord)
- private
- FCommentType: Byte;
- FCommentClass: Byte;
- FCommentString: string;
- function GetNoList: Boolean;
- function GetNoPurge: Boolean;
- procedure SetNoList(AValue: Boolean);
- procedure SetNoPurge(AValue: Boolean);
- public
- procedure DecodeFrom(RawRecord: TOmfRawRecord);override;
- procedure EncodeTo(RawRecord: TOmfRawRecord);override;
- property CommentType: Byte read FCommentType write FCommentType;
- property CommentClass: Byte read FCommentClass write FCommentClass;
- property CommentString: string read FCommentString write FCommentString;
- property NoPurge: Boolean read GetNoPurge write SetNoPurge;
- property NoList: Boolean read GetNoList write SetNoList;
- end;
- { TOmfRecord_LNAMES }
- TOmfRecord_LNAMES = class(TOmfParsedRecord)
- private
- FNames: TOmfOrderedNameCollection;
- FNextIndex: Integer;
- public
- constructor Create;
- procedure DecodeFrom(RawRecord: TOmfRawRecord);override;
- procedure EncodeTo(RawRecord: TOmfRawRecord);override;
- property Names: TOmfOrderedNameCollection read FNames write FNames;
- property NextIndex: Integer read FNextIndex write FNextIndex;
- end;
- { TOmfRecord_SEGDEF }
- TOmfRecord_SEGDEF = class(TOmfParsedRecord)
- private
- FAlignment: TOmfSegmentAlignment;
- FCombination: TOmfSegmentCombination;
- FUse: TOmfSegmentUse;
- FFrameNumber: Word;
- FOffset: Byte;
- FIs32Bit: Boolean;
- FSegmentLength: Int64; { int64, because it can be 2**32 }
- FSegmentNameIndex: Integer;
- FClassNameIndex: Integer;
- FOverlayNameIndex: Integer;
- public
- procedure DecodeFrom(RawRecord: TOmfRawRecord);override;
- procedure EncodeTo(RawRecord: TOmfRawRecord);override;
- property Alignment: TOmfSegmentAlignment read FAlignment write FAlignment;
- property Combination: TOmfSegmentCombination read FCombination write FCombination;
- property Use: TOmfSegmentUse read FUse write FUse;
- property FrameNumber: Word read FFrameNumber write FFrameNumber;
- property Offset: Byte read FOffset write FOffset;
- property Is32Bit: Boolean read FIs32Bit write FIs32Bit;
- property SegmentLength: Int64 read FSegmentLength write FSegmentLength;
- property SegmentNameIndex: Integer read FSegmentNameIndex write FSegmentNameIndex;
- property ClassNameIndex: Integer read FClassNameIndex write FClassNameIndex;
- property OverlayNameIndex: Integer read FOverlayNameIndex write FOverlayNameIndex;
- end;
- TSegmentList = array of Integer;
- { TOmfRecord_GRPDEF }
- TOmfRecord_GRPDEF = class(TOmfParsedRecord)
- private
- FGroupNameIndex: Integer;
- FSegmentList: TSegmentList;
- public
- procedure DecodeFrom(RawRecord: TOmfRawRecord);override;
- procedure EncodeTo(RawRecord: TOmfRawRecord);override;
- property GroupNameIndex: Integer read FGroupNameIndex write FGroupNameIndex;
- property SegmentList: TSegmentList read FSegmentList write FSegmentList;
- end;
- { TOmfPublicNameElement }
- TOmfPublicNameElement = class(TFPHashObject)
- private
- FPublicOffset: DWord;
- FTypeIndex: Integer;
- public
- function GetLengthInFile(Is32Bit: Boolean): Integer;
- property PublicOffset: DWord read FPublicOffset write FPublicOffset;
- property TypeIndex: Integer read FTypeIndex write FTypeIndex;
- end;
- { TOmfRecord_PUBDEF }
- TOmfRecord_PUBDEF = class(TOmfParsedRecord)
- private
- FIs32Bit: Boolean;
- FBaseGroupIndex: Integer;
- FBaseSegmentIndex: Integer;
- FBaseFrame: Word;
- FPublicNames: TFPHashObjectList;
- FNextIndex: Integer;
- public
- procedure DecodeFrom(RawRecord: TOmfRawRecord);override;
- procedure EncodeTo(RawRecord: TOmfRawRecord);override;
- property Is32Bit: Boolean read FIs32Bit write FIs32Bit;
- property BaseGroupIndex: Integer read FBaseGroupIndex write FBaseGroupIndex;
- property BaseSegmentIndex: Integer read FBaseSegmentIndex write FBaseSegmentIndex;
- property BaseFrame: Word read FBaseFrame write FBaseFrame;
- property PublicNames: TFPHashObjectList read FPublicNames write FPublicNames;
- property NextIndex: Integer read FNextIndex write FNextIndex;
- end;
- { TOmfExternalNameElement }
- TOmfExternalNameElement = class(TFPHashObject)
- private
- FTypeIndex: Integer;
- public
- function GetLengthInFile: Integer;
- property TypeIndex: Integer read FTypeIndex write FTypeIndex;
- end;
- { TOmfRecord_EXTDEF }
- TOmfRecord_EXTDEF = class(TOmfParsedRecord)
- private
- FExternalNames: TFPHashObjectList;
- FNextIndex: Integer;
- public
- procedure DecodeFrom(RawRecord: TOmfRawRecord);override;
- procedure EncodeTo(RawRecord: TOmfRawRecord);override;
- property ExternalNames: TFPHashObjectList read FExternalNames write FExternalNames;
- property NextIndex: Integer read FNextIndex write FNextIndex;
- end;
- { TOmfRecord_MODEND }
- TOmfRecord_MODEND = class(TOmfParsedRecord)
- private
- FIs32Bit: Boolean;
- FIsMainModule: Boolean;
- FHasStartAddress: Boolean;
- FSegmentBit: Boolean;
- FLogicalStartAddress: Boolean;
- FFrameMethod: TOmfFixupFrameMethod;
- FFrameDatum: Integer;
- FTargetMethod: TOmfFixupTargetMethod;
- FTargetDatum: Integer;
- FTargetDisplacement: DWord;
- FPhysFrameNumber: Word;
- FPhysOffset: DWord;
- public
- procedure DecodeFrom(RawRecord: TOmfRawRecord);override;
- procedure EncodeTo(RawRecord: TOmfRawRecord);override;
- property Is32Bit: Boolean read FIs32Bit write FIs32Bit;
- property IsMainModule: Boolean read FIsMainModule write FIsMainModule;
- property HasStartAddress: Boolean read FHasStartAddress write FHasStartAddress;
- property SegmentBit: Boolean read FSegmentBit write FSegmentBit;
- property LogicalStartAddress: Boolean read FLogicalStartAddress write FLogicalStartAddress;
- { properties, specifying a logical start address (used when LogicalStartAddress=true) }
- property FrameMethod: TOmfFixupFrameMethod read FFrameMethod write FFrameMethod;
- property FrameDatum: Integer read FFrameDatum write FFrameDatum;
- property TargetMethod: TOmfFixupTargetMethod read FTargetMethod write FTargetMethod;
- property TargetDatum: Integer read FTargetDatum write FTargetDatum;
- property TargetDisplacement: DWord read FTargetDisplacement write FTargetDisplacement;
- { properties, specifying a physical start address (used when LogicalStartAddress=false) }
- property PhysFrameNumber: Word read FPhysFrameNumber write FPhysFrameNumber;
- property PhysOffset: DWord read FPhysOffset write FPhysOffset;
- end;
- { TOmfSubRecord_FIXUP }
- TOmfSubRecord_FIXUP = class
- private
- FIs32Bit: Boolean;
- FMode: TOmfFixupMode;
- FLocationType: TOmfFixupLocationType;
- FLocationOffset: DWord;
- FDataRecordStartOffset: DWord;
- FTargetDeterminedByThread: Boolean;
- FTargetThread: TOmfFixupThread;
- FTargetThreadDisplacementPresent: Boolean;
- FTargetMethod: TOmfFixupTargetMethod;
- FTargetDatum: Integer;
- FTargetDisplacement: DWord;
- FFrameDeterminedByThread: Boolean;
- FFrameThread: TOmfFixupThread;
- FFrameMethod: TOmfFixupFrameMethod;
- FFrameDatum: Integer;
- function GetDataRecordOffset: Integer;
- function GetLocationSize: Integer;
- procedure SetDataRecordOffset(AValue: Integer);
- public
- function ReadAt(RawRecord: TOmfRawRecord; Offset: Integer): Integer;
- function WriteAt(RawRecord: TOmfRawRecord; Offset: Integer): Integer;
- property Is32Bit: Boolean read FIs32Bit write FIs32Bit;
- property Mode: TOmfFixupMode read FMode write FMode;
- property LocationType: TOmfFixupLocationType read FLocationType write FLocationType;
- property LocationOffset: DWord read FLocationOffset write FLocationOffset;
- property LocationSize: Integer read GetLocationSize;
- property DataRecordStartOffset: DWord read FDataRecordStartOffset write FDataRecordStartOffset;
- property DataRecordOffset: Integer read GetDataRecordOffset write SetDataRecordOffset;
- property TargetDeterminedByThread: Boolean read FTargetDeterminedByThread write FTargetDeterminedByThread;
- property TargetThread: TOmfFixupThread read FTargetThread write FTargetThread;
- property TargetThreadDisplacementPresent: Boolean read FTargetThreadDisplacementPresent write FTargetThreadDisplacementPresent;
- property TargetMethod: TOmfFixupTargetMethod read FTargetMethod write FTargetMethod;
- property TargetDatum: Integer read FTargetDatum write FTargetDatum;
- property TargetDisplacement: DWord read FTargetDisplacement write FTargetDisplacement;
- property FrameDeterminedByThread: Boolean read FFrameDeterminedByThread write FFrameDeterminedByThread;
- property FrameThread: TOmfFixupThread read FFrameThread write FFrameThread;
- property FrameMethod: TOmfFixupFrameMethod read FFrameMethod write FFrameMethod;
- property FrameDatum: Integer read FFrameDatum write FFrameDatum;
- end;
- { TOmfRecord_LIBHEAD }
- TOmfRecord_LIBHEAD = class(TOmfParsedRecord)
- private
- FPageSize: Integer;
- FDictionaryOffset: DWord;
- FDictionarySizeInBlocks: Word;
- FFlags: Byte;
- function IsCaseSensitive: Boolean;
- procedure SetCaseSensitive(AValue: Boolean);
- procedure SetPageSize(AValue: Integer);
- public
- constructor Create;
- procedure DecodeFrom(RawRecord: TOmfRawRecord);override;
- procedure EncodeTo(RawRecord: TOmfRawRecord);override;
- property PageSize: Integer read FPageSize write SetPageSize;
- property DictionaryOffset: DWord read FDictionaryOffset write FDictionaryOffset;
- property DictionarySizeInBlocks: Word read FDictionarySizeInBlocks write FDictionarySizeInBlocks;
- property Flags: Byte read FFlags write FFlags;
- property CaseSensitive: Boolean read IsCaseSensitive write SetCaseSensitive;
- end;
- { TOmfRecord_LIBEND }
- TOmfRecord_LIBEND = class(TOmfParsedRecord)
- private
- FPaddingBytes: Word;
- public
- procedure DecodeFrom(RawRecord: TOmfRawRecord);override;
- procedure EncodeTo(RawRecord: TOmfRawRecord);override;
- procedure CalculatePaddingBytes(RecordStartOffset: DWord);
- property PaddingBytes: Word read FPaddingBytes write FPaddingBytes;
- end;
- const
- { list of all the possible omf library dictionary block counts - contains
- all the prime numbers less than 255 }
- OmfLibDictionaryBlockCounts: array [0..53] of Byte =
- (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,
- 101,103,107,109,113,127,131,137,139,149,151,157,163,167,173,179,181,191,
- 193,197,199,211,223,227,229,233,239,241,251);
- type
- TOmfLibHash = record
- block_x: Integer;
- block_d: Integer;
- bucket_x: Integer;
- bucket_d: Integer;
- end;
- function compute_omf_lib_hash(const name: string; blocks: Integer): TOmfLibHash;
- implementation
- uses
- cutils,
- verbose;
- { TOmfOrderedNameCollection }
- function TOmfOrderedNameCollection.GetString(Index: Integer): string;
- begin
- Result:=FStringList[Index-1];
- end;
- function TOmfOrderedNameCollection.GetCount: Integer;
- begin
- Result:=Length(FStringList);
- end;
- procedure TOmfOrderedNameCollection.SetString(Index: Integer; AValue: string);
- begin
- FStringList[Index-1]:=AValue;
- end;
- function TOmfOrderedNameCollection.Add(const S: string): Integer;
- begin
- Result:=Length(FStringList)+1;
- SetLength(FStringList,Result);
- FStringList[Result-1]:=S;
- end;
- procedure TOmfOrderedNameCollection.Clear;
- begin
- SetLength(FStringList,0);
- end;
- { TOmfRawRecord }
- function TOmfRawRecord.GetRecordType: Byte;
- begin
- Result:=RawData[-3];
- end;
- procedure TOmfRawRecord.SetRecordType(AValue: Byte);
- begin
- RawData[-3]:=AValue;
- end;
- function TOmfRawRecord.GetRecordLength: Word;
- begin
- Result:=RawData[-2] or (RawData[-1] shl 8);
- end;
- procedure TOmfRawRecord.SetRecordLength(AValue: Word);
- begin
- RawData[-2]:=Byte(AValue);
- RawData[-1]:=Byte(AValue shr 8);
- end;
- function TOmfRawRecord.ReadStringAt(Offset: Integer; out s: string): Integer;
- var
- len: Byte;
- begin
- len:=RawData[Offset];
- Result:=Offset+len+1;
- if result>RecordLength then
- internalerror(2015033103);
- SetLength(s, len);
- UniqueString(s);
- Move(RawData[Offset+1],s[1],len);
- end;
- function TOmfRawRecord.WriteStringAt(Offset: Integer; s: string): Integer;
- begin
- if Length(s)>255 then
- internalerror(2015033101);
- result:=Offset+Length(s)+1;
- if result>High(RawData) then
- internalerror(2015033102);
- RawData[Offset]:=Length(s);
- Move(s[1], RawData[Offset+1], Length(s));
- end;
- function TOmfRawRecord.ReadIndexedRef(Offset: Integer; out IndexedRef: Integer): Integer;
- begin
- Result:=Offset+1;
- if result>RecordLength then
- internalerror(2015033103);
- IndexedRef:=RawData[Offset];
- if IndexedRef<=$7f then
- exit;
- Result:=Offset+2;
- if result>RecordLength then
- internalerror(2015033103);
- IndexedRef:=((IndexedRef and $7f) shl 8)+RawData[Offset+1];
- end;
- function TOmfRawRecord.WriteIndexedRef(Offset: Integer; IndexedRef: Integer): Integer;
- begin
- if (IndexedRef<0) or (IndexedRef>$7FFF) then
- internalerror(2015040303);
- if IndexedRef<=$7f then
- begin
- Result:=Offset+1;
- if Result>High(RawData) then
- internalerror(2015033102);
- RawData[Offset]:=IndexedRef;
- end
- else
- begin
- Result:=Offset+2;
- if Result>High(RawData) then
- internalerror(2015033102);
- RawData[Offset]:=$80+(IndexedRef shr 8);
- RawData[Offset+1]:=Byte(IndexedRef);
- end;
- end;
- function TOmfRawRecord.GetChecksumByte: Byte;
- begin
- if RecordLength>0 then
- Result:=RawData[RecordLength-1]
- else
- Result:=0;
- end;
- procedure TOmfRawRecord.SetChecksumByte(AValue: Byte);
- begin
- if RecordLength>0 then
- RawData[RecordLength-1]:=AValue;
- end;
- procedure TOmfRawRecord.CalculateChecksumByte;
- var
- I: Integer;
- b: Byte;
- begin
- b:=0;
- for I:=-3 to RecordLength-2 do
- b:=byte(b+RawData[I]);
- SetChecksumByte($100-b);
- end;
- function TOmfRawRecord.VerifyChecksumByte: boolean;
- var
- I: Integer;
- b: Byte;
- begin
- { according to the OMF spec, some tools always write a 0 rather than
- computing the checksum, so it should also be accepted as correct }
- if ChecksumByte=0 then
- exit(true);
- b:=0;
- for I:=-3 to RecordLength-1 do
- b:=byte(b+RawData[I]);
- Result:=(b=0);
- end;
- procedure TOmfRawRecord.ReadFrom(aReader: TObjectReader);
- begin
- aReader.read(RawData, 3);
- aReader.read(RawData[0], RecordLength);
- end;
- procedure TOmfRawRecord.ReadFrom(aReader: TDynamicArray);
- begin
- aReader.read(RawData, 3);
- aReader.read(RawData[0], RecordLength);
- end;
- procedure TOmfRawRecord.WriteTo(aWriter: TObjectWriter);
- begin
- aWriter.write(RawData, RecordLength+3);
- end;
- procedure TOmfRawRecord.WriteTo(aWriter: TDynamicArray);
- begin
- aWriter.write(RawData, RecordLength+3);
- end;
- { TOmfRecord_THEADR }
- procedure TOmfRecord_THEADR.DecodeFrom(RawRecord: TOmfRawRecord);
- begin
- if RawRecord.RecordType<>RT_THEADR then
- internalerror(2015040301);
- RawRecord.ReadStringAt(0,FModuleName);
- end;
- procedure TOmfRecord_THEADR.EncodeTo(RawRecord: TOmfRawRecord);
- var
- NextOfs: Integer;
- begin
- RawRecord.RecordType:=RT_THEADR;
- NextOfs:=RawRecord.WriteStringAt(0,ModuleName);
- RawRecord.RecordLength:=NextOfs+1;
- RawRecord.CalculateChecksumByte;
- end;
- { TOmfRecord_COMENT }
- function TOmfRecord_COMENT.GetNoList: Boolean;
- begin
- Result:=(CommentType and $40)<>0;
- end;
- function TOmfRecord_COMENT.GetNoPurge: Boolean;
- begin
- Result:=(CommentType and $80)<>0;
- end;
- procedure TOmfRecord_COMENT.SetNoList(AValue: Boolean);
- begin
- if AValue then
- CommentType:=CommentType or $40
- else
- CommentType:=CommentType and $BF;
- end;
- procedure TOmfRecord_COMENT.SetNoPurge(AValue: Boolean);
- begin
- if AValue then
- CommentType:=CommentType or $80
- else
- CommentType:=CommentType and $7F;
- end;
- procedure TOmfRecord_COMENT.DecodeFrom(RawRecord: TOmfRawRecord);
- begin
- if RawRecord.RecordType<>RT_COMENT then
- internalerror(2015040301);
- if RawRecord.RecordLength<3 then
- internalerror(2015033104);
- CommentType:=RawRecord.RawData[0];
- CommentClass:=RawRecord.RawData[1];
- SetLength(FCommentString,RawRecord.RecordLength-3);
- UniqueString(FCommentString);
- Move(RawRecord.RawData[2],FCommentString[1],Length(FCommentString));
- end;
- procedure TOmfRecord_COMENT.EncodeTo(RawRecord: TOmfRawRecord);
- begin
- RawRecord.RecordType:=RT_COMENT;
- if (Length(FCommentString)+3)>High(RawRecord.RawData) then
- internalerror(2015033105);
- RawRecord.RecordLength:=Length(FCommentString)+3;
- RawRecord.RawData[0]:=CommentType;
- RawRecord.RawData[1]:=CommentClass;
- Move(FCommentString[1],RawRecord.RawData[2],Length(FCommentString));
- RawRecord.CalculateChecksumByte;
- end;
- { TOmfRecord_LNAMES }
- constructor TOmfRecord_LNAMES.Create;
- begin
- FNextIndex:=1;
- end;
- procedure TOmfRecord_LNAMES.DecodeFrom(RawRecord: TOmfRawRecord);
- var
- NextOfs: Integer;
- Name: string;
- begin
- if RawRecord.RecordType<>RT_LNAMES then
- internalerror(2015040301);
- NextOfs:=0;
- while NextOfs<(RawRecord.RecordLength-1) do
- begin
- NextOfs:=RawRecord.ReadStringAt(NextOfs,Name);
- Names.Add(Name);
- end;
- end;
- procedure TOmfRecord_LNAMES.EncodeTo(RawRecord: TOmfRawRecord);
- const
- RecordLengthLimit = 1024;
- var
- Len,LastIncludedIndex,NextOfs,I: Integer;
- begin
- RawRecord.RecordType:=RT_LNAMES;
- { find out how many strings can we include until we reach the length limit }
- Len:=1;
- LastIncludedIndex:=NextIndex-1;
- repeat
- Inc(LastIncludedIndex);
- Inc(Len,Length(Names[LastIncludedIndex])+1);
- until (LastIncludedIndex>=Names.Count) or ((Len+Length(Names[LastIncludedIndex+1])+1)>=RecordLengthLimit);
- { write the strings... }
- NextOfs:=0;
- for I:=NextIndex to LastIncludedIndex do
- NextOfs:=RawRecord.WriteStringAt(NextOfs,Names[I]);
- RawRecord.RecordLength:=Len;
- RawRecord.CalculateChecksumByte;
- { update NextIndex }
- NextIndex:=LastIncludedIndex+1;
- end;
- { TOmfRecord_SEGDEF }
- procedure TOmfRecord_SEGDEF.DecodeFrom(RawRecord: TOmfRawRecord);
- var
- B: Byte;
- Big: Boolean;
- NextOfs: Integer;
- MinLen: Integer;
- begin
- if not (RawRecord.RecordType in [RT_SEGDEF,RT_SEGDEF32]) then
- internalerror(2015040301);
- Is32Bit:=RawRecord.RecordType=RT_SEGDEF32;
- MinLen:=7; { b(1)+seglength(2..4)+segnameindex(1..2)+classnameindex(1..2)+overlaynameindex(1..2)+checksum }
- if Is32Bit then
- inc(MinLen,2);
- if RawRecord.RecordLength<MinLen then
- internalerror(2015040305);
- B:=RawRecord.RawData[0];
- Alignment:=TOmfSegmentAlignment(B shr 5);
- Combination:=TOmfSegmentCombination((B shr 2) and 7);
- Big:=(B and 2)<>0;
- Use:=TOmfSegmentUse(B and 1);
- NextOfs:=1;
- if Alignment=saAbsolute then
- begin
- inc(MinLen,3);
- if RawRecord.RecordLength<MinLen then
- internalerror(2015040305);
- FrameNumber:=RawRecord.RawData[1]+(RawRecord.RawData[2] shl 8);
- Offset:=RawRecord.RawData[3];
- NextOfs:=4;
- end
- else
- begin
- FrameNumber:=0;
- Offset:=0;
- end;
- if Is32Bit then
- begin
- SegmentLength:=RawRecord.RawData[NextOfs]+
- (RawRecord.RawData[NextOfs+1] shl 8)+
- (RawRecord.RawData[NextOfs+2] shl 16)+
- (RawRecord.RawData[NextOfs+3] shl 24);
- if Big then
- if SegmentLength=0 then
- SegmentLength:=4294967296
- else
- internalerror(2015040306);
- Inc(NextOfs,4);
- end
- else
- begin
- SegmentLength:=RawRecord.RawData[NextOfs]+(RawRecord.RawData[NextOfs+1] shl 8);
- if Big then
- if SegmentLength=0 then
- SegmentLength:=65536
- else
- internalerror(2015040306);
- Inc(NextOfs,2);
- end;
- NextOfs:=RawRecord.ReadIndexedRef(NextOfs,FSegmentNameIndex);
- NextOfs:=RawRecord.ReadIndexedRef(NextOfs,FClassNameIndex);
- NextOfs:=RawRecord.ReadIndexedRef(NextOfs,FOverlayNameIndex);
- end;
- procedure TOmfRecord_SEGDEF.EncodeTo(RawRecord: TOmfRawRecord);
- var
- Big: Boolean;
- NextOfs: Integer;
- begin
- if Is32Bit then
- begin
- RawRecord.RecordType:=RT_SEGDEF32;
- if SegmentLength>4294967296 then
- internalerror(2015040302);
- Big:=SegmentLength=4294967296;
- end
- else
- begin
- RawRecord.RecordType:=RT_SEGDEF;
- if SegmentLength>65536 then
- internalerror(2015040302);
- Big:=SegmentLength=65536;
- end;
- RawRecord.RawData[0]:=(Ord(Alignment) shl 5) or (Ord(Combination) shl 2) or (Ord(Big) shl 1) or Ord(Use);
- NextOfs:=1;
- if Alignment=saAbsolute then
- begin
- RawRecord.RawData[1]:=Byte(FrameNumber);
- RawRecord.RawData[2]:=Byte(FrameNumber shr 8);
- RawRecord.RawData[3]:=Offset;
- NextOfs:=4;
- end;
- if Is32Bit then
- begin
- RawRecord.RawData[NextOfs]:=Byte(SegmentLength);
- RawRecord.RawData[NextOfs+1]:=Byte(SegmentLength shr 8);
- RawRecord.RawData[NextOfs+2]:=Byte(SegmentLength shr 16);
- RawRecord.RawData[NextOfs+3]:=Byte(SegmentLength shr 24);
- Inc(NextOfs,4);
- end
- else
- begin
- RawRecord.RawData[NextOfs]:=Byte(SegmentLength);
- RawRecord.RawData[NextOfs+1]:=Byte(SegmentLength shr 8);
- Inc(NextOfs,2);
- end;
- NextOfs:=RawRecord.WriteIndexedRef(NextOfs,SegmentNameIndex);
- NextOfs:=RawRecord.WriteIndexedRef(NextOfs,ClassNameIndex);
- NextOfs:=RawRecord.WriteIndexedRef(NextOfs,OverlayNameIndex);
- RawRecord.RecordLength:=NextOfs+1;
- RawRecord.CalculateChecksumByte;
- end;
- { TOmfRecord_GRPDEF }
- procedure TOmfRecord_GRPDEF.DecodeFrom(RawRecord: TOmfRawRecord);
- var
- NextOfs: Integer;
- Segment: Integer;
- begin
- if RawRecord.RecordType<>RT_GRPDEF then
- internalerror(2015040301);
- NextOfs:=RawRecord.ReadIndexedRef(0,FGroupNameIndex);
- SetLength(FSegmentList,0);
- while NextOfs<RawRecord.RecordLength-1 do
- begin
- if RawRecord.RawData[NextOfs]<>$ff then
- internalerror(2015040901);
- NextOfs:=RawRecord.ReadIndexedRef(NextOfs+1,Segment);
- SetLength(FSegmentList,Length(FSegmentList)+1);
- FSegmentList[High(FSegmentList)]:=Segment;
- end;
- end;
- procedure TOmfRecord_GRPDEF.EncodeTo(RawRecord: TOmfRawRecord);
- var
- NextOfs: Integer;
- Segment: Integer;
- begin
- RawRecord.RecordType:=RT_GRPDEF;
- NextOfs:=RawRecord.WriteIndexedRef(0,GroupNameIndex);
- for Segment in SegmentList do
- begin
- if NextOfs>High(RawRecord.RawData) then
- internalerror(2015040401);
- RawRecord.RawData[NextOfs]:=$ff;
- NextOfs:=RawRecord.WriteIndexedRef(NextOfs+1,Segment);
- end;
- RawRecord.RecordLength:=NextOfs+1;
- RawRecord.CalculateChecksumByte;
- end;
- { TOmfPublicNameElement }
- function TOmfPublicNameElement.GetLengthInFile(Is32Bit: Boolean): Integer;
- begin
- Result:=1+Length(Name)+2+1;
- if Is32Bit then
- Inc(Result,2);
- if TypeIndex>=$80 then
- Inc(Result);
- end;
- { TOmfRecord_PUBDEF }
- procedure TOmfRecord_PUBDEF.DecodeFrom(RawRecord: TOmfRawRecord);
- var
- NextOfs: Integer;
- Name: string;
- TypeIndex: Integer;
- PublicOffset: DWord;
- PubName: TOmfPublicNameElement;
- begin
- if not (RawRecord.RecordType in [RT_PUBDEF,RT_PUBDEF32]) then
- internalerror(2015040301);
- Is32Bit:=RawRecord.RecordType=RT_PUBDEF32;
- NextOfs:=RawRecord.ReadIndexedRef(0,FBaseGroupIndex);
- NextOfs:=RawRecord.ReadIndexedRef(NextOfs,FBaseSegmentIndex);
- if BaseSegmentIndex=0 then
- begin
- if (NextOfs+1)>=RawRecord.RecordLength then
- internalerror(2015041401);
- BaseFrame:=RawRecord.RawData[NextOfs]+(RawRecord.RawData[NextOfs+1] shl 8);
- Inc(NextOfs,2);
- end
- else
- BaseFrame:=0;
- while NextOfs<(RawRecord.RecordLength-1) do
- begin
- NextOfs:=RawRecord.ReadStringAt(NextOfs,Name);
- if Is32Bit then
- begin
- if (NextOfs+3)>=RawRecord.RecordLength then
- internalerror(2015041401);
- PublicOffset:=RawRecord.RawData[NextOfs]+(RawRecord.RawData[NextOfs+1] shl 8)+
- (RawRecord.RawData[NextOfs+2] shl 16)+(RawRecord.RawData[NextOfs+3] shl 24);
- Inc(NextOfs,4);
- end
- else
- begin
- if (NextOfs+1)>=RawRecord.RecordLength then
- internalerror(2015041401);
- PublicOffset:=RawRecord.RawData[NextOfs]+(RawRecord.RawData[NextOfs+1] shl 8);
- Inc(NextOfs,2);
- end;
- NextOfs:=RawRecord.ReadIndexedRef(NextOfs,TypeIndex);
- PubName:=TOmfPublicNameElement.Create(PublicNames,Name);
- PubName.PublicOffset:=PublicOffset;
- PubName.TypeIndex:=TypeIndex;
- end;
- end;
- procedure TOmfRecord_PUBDEF.EncodeTo(RawRecord: TOmfRawRecord);
- const
- RecordLengthLimit = 1024;
- var
- Len,LastIncludedIndex,NextOfs,I: Integer;
- PubName: TOmfPublicNameElement;
- begin
- if Is32Bit then
- RawRecord.RecordType:=RT_PUBDEF32
- else
- RawRecord.RecordType:=RT_PUBDEF;
- NextOfs:=RawRecord.WriteIndexedRef(0,BaseGroupIndex);
- NextOfs:=RawRecord.WriteIndexedRef(NextOfs,BaseSegmentIndex);
- if BaseSegmentIndex=0 then
- begin
- RawRecord.RawData[NextOfs]:=Byte(BaseFrame);
- RawRecord.RawData[NextOfs+1]:=Byte(BaseFrame shr 8);
- Inc(NextOfs,2);
- end;
- { find out how many public names can we include until we reach the length limit }
- Len:=NextOfs;
- LastIncludedIndex:=NextIndex-1;
- repeat
- Inc(LastIncludedIndex);
- Inc(Len,TOmfPublicNameElement(PublicNames[LastIncludedIndex]).GetLengthInFile(Is32Bit));
- until (LastIncludedIndex>=(PublicNames.Count-1)) or ((Len+TOmfPublicNameElement(PublicNames[LastIncludedIndex+1]).GetLengthInFile(Is32Bit))>=RecordLengthLimit);
- { write the public names... }
- for I:=NextIndex to LastIncludedIndex do
- begin
- PubName:=TOmfPublicNameElement(PublicNames[I]);
- NextOfs:=RawRecord.WriteStringAt(NextOfs,PubName.Name);
- if Is32Bit then
- begin
- RawRecord.RawData[NextOfs]:=Byte(PubName.PublicOffset);
- RawRecord.RawData[NextOfs+1]:=Byte(PubName.PublicOffset shr 8);
- RawRecord.RawData[NextOfs+2]:=Byte(PubName.PublicOffset shr 16);
- RawRecord.RawData[NextOfs+3]:=Byte(PubName.PublicOffset shr 24);
- Inc(NextOfs,4);
- end
- else
- begin
- if PubName.PublicOffset>$ffff then
- internalerror(2015041403);
- RawRecord.RawData[NextOfs]:=Byte(PubName.PublicOffset);
- RawRecord.RawData[NextOfs+1]:=Byte(PubName.PublicOffset shr 8);
- Inc(NextOfs,2);
- end;
- NextOfs:=RawRecord.WriteIndexedRef(NextOfs,PubName.TypeIndex);
- end;
- RawRecord.RecordLength:=Len+1;
- RawRecord.CalculateChecksumByte;
- { update NextIndex }
- NextIndex:=LastIncludedIndex+1;
- end;
- { TOmfExternalNameElement }
- function TOmfExternalNameElement.GetLengthInFile: Integer;
- begin
- Result:=1+Length(Name)+1;
- if TypeIndex>=$80 then
- Inc(Result);
- end;
- { TOmfRecord_EXTDEF }
- procedure TOmfRecord_EXTDEF.DecodeFrom(RawRecord: TOmfRawRecord);
- var
- NextOfs: Integer;
- Name: string;
- TypeIndex: Integer;
- ExtName: TOmfExternalNameElement;
- begin
- if RawRecord.RecordType<>RT_EXTDEF then
- internalerror(2015040301);
- NextOfs:=0;
- while NextOfs<(RawRecord.RecordLength-1) do
- begin
- NextOfs:=RawRecord.ReadStringAt(NextOfs,Name);
- NextOfs:=RawRecord.ReadIndexedRef(NextOfs,TypeIndex);
- ExtName:=TOmfExternalNameElement.Create(ExternalNames,Name);
- ExtName.TypeIndex:=TypeIndex;
- end;
- end;
- procedure TOmfRecord_EXTDEF.EncodeTo(RawRecord: TOmfRawRecord);
- const
- RecordLengthLimit = 1024;
- var
- Len,LastIncludedIndex,NextOfs,I: Integer;
- ExtName: TOmfExternalNameElement;
- begin
- RawRecord.RecordType:=RT_EXTDEF;
- NextOfs:=0;
- { find out how many external names can we include until we reach the length limit }
- Len:=NextOfs;
- LastIncludedIndex:=NextIndex-1;
- repeat
- Inc(LastIncludedIndex);
- Inc(Len,TOmfExternalNameElement(ExternalNames[LastIncludedIndex]).GetLengthInFile);
- until (LastIncludedIndex>=(ExternalNames.Count-1)) or ((Len+TOmfExternalNameElement(ExternalNames[LastIncludedIndex+1]).GetLengthInFile)>=RecordLengthLimit);
- { write the external names... }
- for I:=NextIndex to LastIncludedIndex do
- begin
- ExtName:=TOmfExternalNameElement(ExternalNames[I]);
- NextOfs:=RawRecord.WriteStringAt(NextOfs,ExtName.Name);
- NextOfs:=RawRecord.WriteIndexedRef(NextOfs,ExtName.TypeIndex);
- end;
- RawRecord.RecordLength:=Len+1;
- RawRecord.CalculateChecksumByte;
- { update NextIndex }
- NextIndex:=LastIncludedIndex+1;
- end;
- { TOmfRecord_MODEND }
- procedure TOmfRecord_MODEND.DecodeFrom(RawRecord: TOmfRawRecord);
- var
- ModTyp: Byte;
- NextOfs: Integer;
- EndData: Byte;
- begin
- if not (RawRecord.RecordType in [RT_MODEND,RT_MODEND32]) then
- internalerror(2015040301);
- Is32Bit:=RawRecord.RecordType=RT_MODEND32;
- if RawRecord.RecordLength<2 then
- internalerror(2015040305);
- ModTyp:=RawRecord.RawData[0];
- IsMainModule:=(ModTyp and $80)<>0;
- HasStartAddress:=(ModTyp and $40)<>0;
- SegmentBit:=(ModTyp and $20)<>0;
- LogicalStartAddress:=(ModTyp and $01)<>0;
- if (ModTyp and $1E)<>0 then
- internalerror(2015041404);
- NextOfs:=1;
- { clear all the start address properties first }
- FrameMethod:=Low(FrameMethod);
- FrameDatum:=0;
- TargetMethod:=Low(TargetMethod);
- TargetDatum:=0;
- TargetDisplacement:=0;
- PhysFrameNumber:=0;
- PhysOffset:=0;
- if HasStartAddress then
- begin
- if LogicalStartAddress then
- begin
- if NextOfs>=RawRecord.RecordLength then
- internalerror(2015040305);
- EndData:=RawRecord.RawData[NextOfs];
- Inc(NextOfs);
- { frame and target method determined by thread is not allowed in MODEND records }
- if (EndData and $88)<>0 then
- internalerror(2015041406);
- FrameMethod:=TOmfFixupFrameMethod((EndData shr 4) and 7);
- TargetMethod:=TOmfFixupTargetMethod(EndData and 7);
- { frame method ffmLocation is not allowed in an MODEND record }
- if FrameMethod=ffmLocation then
- internalerror(2015041402);
- { read Frame Datum? }
- if FrameMethod in [ffmSegmentIndex,ffmGroupIndex,ffmExternalIndex,ffmFrameNumber] then
- NextOfs:=RawRecord.ReadIndexedRef(NextOfs,FFrameDatum);
- { read Target Datum? }
- NextOfs:=RawRecord.ReadIndexedRef(NextOfs,FTargetDatum);
- { read Target Displacement? }
- if TargetMethod in [ftmSegmentIndex,ftmGroupIndex,ftmExternalIndex,ftmFrameNumber] then
- begin
- if Is32Bit then
- begin
- if (NextOfs+3)>=RawRecord.RecordLength then
- internalerror(2015040504);
- TargetDisplacement := RawRecord.RawData[NextOfs]+
- (RawRecord.RawData[NextOfs+1] shl 8)+
- (RawRecord.RawData[NextOfs+2] shl 16)+
- (RawRecord.RawData[NextOfs+3] shl 24);
- Inc(NextOfs,4);
- end
- else
- begin
- if (NextOfs+1)>=RawRecord.RecordLength then
- internalerror(2015040504);
- TargetDisplacement := RawRecord.RawData[NextOfs]+
- (RawRecord.RawData[NextOfs+1] shl 8);
- Inc(NextOfs,2);
- end;
- end;
- end
- else
- begin
- { physical start address }
- if (NextOfs+1)>=RawRecord.RecordLength then
- internalerror(2015040305);
- PhysFrameNumber:=RawRecord.RawData[NextOfs]+(RawRecord.RawData[NextOfs+1] shl 8);
- Inc(NextOfs,2);
- if Is32Bit then
- begin
- if (NextOfs+3)>=RawRecord.RecordLength then
- internalerror(2015040305);
- PhysOffset:=RawRecord.RawData[NextOfs]+(RawRecord.RawData[NextOfs+1] shl 8)+
- (RawRecord.RawData[NextOfs+2] shl 16)+(RawRecord.RawData[NextOfs+3] shl 24);
- Inc(NextOfs,4);
- end
- else
- begin
- if (NextOfs+1)>=RawRecord.RecordLength then
- internalerror(2015040305);
- PhysOffset:=RawRecord.RawData[NextOfs]+(RawRecord.RawData[NextOfs+1] shl 8);
- Inc(NextOfs,2);
- end;
- end;
- end;
- end;
- procedure TOmfRecord_MODEND.EncodeTo(RawRecord: TOmfRawRecord);
- var
- ModTyp: Byte;
- NextOfs: Integer;
- EndData: Byte;
- begin
- if Is32Bit then
- RawRecord.RecordType:=RT_MODEND32
- else
- RawRecord.RecordType:=RT_MODEND;
- ModTyp:=(Ord(IsMainModule) shl 7)+(Ord(HasStartAddress) shl 6)+(Ord(SegmentBit) shl 5)+Ord(LogicalStartAddress);
- RawRecord.RawData[0]:=ModTyp;
- NextOfs:=1;
- if HasStartAddress then
- begin
- if LogicalStartAddress then
- begin
- { frame method ffmLocation is not allowed in an MODEND record }
- if FrameMethod=ffmLocation then
- internalerror(2015041402);
- EndData:=(Ord(FrameMethod) shl 4)+Ord(TargetMethod);
- RawRecord.RawData[NextOfs]:=EndData;
- Inc(NextOfs);
- { save Frame Datum? }
- if FrameMethod in [ffmSegmentIndex,ffmGroupIndex,ffmExternalIndex,ffmFrameNumber] then
- NextOfs:=RawRecord.WriteIndexedRef(NextOfs,FrameDatum);
- { save Target Datum? }
- NextOfs:=RawRecord.WriteIndexedRef(NextOfs,TargetDatum);
- { save Target Displacement? }
- if TargetMethod in [ftmSegmentIndex,ftmGroupIndex,ftmExternalIndex,ftmFrameNumber] then
- begin
- if Is32Bit then
- begin
- RawRecord.RawData[NextOfs]:=Byte(TargetDisplacement);
- RawRecord.RawData[NextOfs+1]:=Byte(TargetDisplacement shr 8);
- RawRecord.RawData[NextOfs+2]:=Byte(TargetDisplacement shr 16);
- RawRecord.RawData[NextOfs+3]:=Byte(TargetDisplacement shr 24);
- Inc(NextOfs,4);
- end
- else
- begin
- if TargetDisplacement>$ffff then
- internalerror(2015040502);
- RawRecord.RawData[NextOfs]:=Byte(TargetDisplacement);
- RawRecord.RawData[NextOfs+1]:=Byte(TargetDisplacement shr 8);
- Inc(NextOfs,2);
- end;
- end;
- end
- else
- begin
- { physical start address }
- RawRecord.RawData[NextOfs]:=Byte(PhysFrameNumber);
- RawRecord.RawData[NextOfs+1]:=Byte(PhysFrameNumber shr 8);
- Inc(NextOfs,2);
- if Is32Bit then
- begin
- RawRecord.RawData[NextOfs]:=Byte(PhysOffset);
- RawRecord.RawData[NextOfs+1]:=Byte(PhysOffset shr 8);
- RawRecord.RawData[NextOfs+2]:=Byte(PhysOffset shr 16);
- RawRecord.RawData[NextOfs+3]:=Byte(PhysOffset shr 24);
- Inc(NextOfs,4);
- end
- else
- begin
- if PhysOffset>$ffff then
- internalerror(2015040502);
- RawRecord.RawData[NextOfs]:=Byte(PhysOffset);
- RawRecord.RawData[NextOfs+1]:=Byte(PhysOffset shr 8);
- Inc(NextOfs,2);
- end;
- end;
- end;
- RawRecord.RecordLength:=NextOfs+1;
- RawRecord.CalculateChecksumByte;
- end;
- { TOmfSubRecord_FIXUP }
- function TOmfSubRecord_FIXUP.GetDataRecordOffset: Integer;
- begin
- Result:=FLocationOffset-FDataRecordStartOffset;
- end;
- function TOmfSubRecord_FIXUP.GetLocationSize: Integer;
- const
- OmfLocationType2Size: array [TOmfFixupLocationType] of Integer=
- (1, // fltLoByte
- 2, // fltOffset
- 2, // fltBase
- 4, // fltFarPointer
- 1, // fltHiByte
- 2, // fltLoaderResolvedOffset (PharLap: Offset32)
- 0, // fltUndefined6 (PharLap: Pointer48)
- 0, // fltUndefined7
- 0, // fltUndefined8
- 4, // fltOffset32
- 0, // fltUndefined10
- 6, // fltFarPointer48
- 0, // fltUndefined12
- 4, // fltLoaderResolvedOffset32
- 0, // fltUndefined14
- 0); // fltUndefined15
- begin
- Result:=OmfLocationType2Size[LocationType];
- end;
- procedure TOmfSubRecord_FIXUP.SetDataRecordOffset(AValue: Integer);
- begin
- FLocationOffset:=AValue+FDataRecordStartOffset;
- end;
- function TOmfSubRecord_FIXUP.ReadAt(RawRecord: TOmfRawRecord; Offset: Integer): Integer;
- var
- Locat: Word;
- FixData: Byte;
- begin
- if (Offset+2)>=RawRecord.RecordLength then
- internalerror(2015040504);
- { unlike other fields in the OMF format, this one is big endian }
- Locat:=(RawRecord.RawData[Offset] shl 8) or RawRecord.RawData[Offset+1];
- FixData:=RawRecord.RawData[Offset+2];
- Inc(Offset,3);
- if (Locat and $8000)=0 then
- internalerror(2015040503);
- DataRecordOffset:=Locat and $3FF;
- LocationType:=TOmfFixupLocationType((Locat shr 10) and 15);
- Mode:=TOmfFixupMode((Locat shr 14) and 1);
- FrameDeterminedByThread:=(FixData and $80)<>0;
- TargetDeterminedByThread:=(FixData and $08)<>0;
- if FrameDeterminedByThread then
- FrameThread:=TOmfFixupThread((FixData shr 4) and 3)
- else
- FrameMethod:=TOmfFixupFrameMethod((FixData shr 4) and 7);
- if TargetDeterminedByThread then
- begin
- TargetThread:=TOmfFixupThread(FixData and 3);
- TargetThreadDisplacementPresent:=(FixData and $40)=0;
- end
- else
- TargetMethod:=TOmfFixupTargetMethod(FixData and 7);
- { read Frame Datum? }
- if not FrameDeterminedByThread and (FrameMethod in [ffmSegmentIndex,ffmGroupIndex,ffmExternalIndex,ffmFrameNumber]) then
- Offset:=RawRecord.ReadIndexedRef(Offset,FFrameDatum)
- else
- FrameDatum:=0;
- { read Target Datum? }
- if not TargetDeterminedByThread then
- Offset:=RawRecord.ReadIndexedRef(Offset,FTargetDatum)
- else
- TargetDatum:=0;
- { read Target Displacement? }
- if (TargetDeterminedByThread and TargetThreadDisplacementPresent) or
- (TargetMethod in [ftmSegmentIndex,ftmGroupIndex,ftmExternalIndex,ftmFrameNumber]) then
- begin
- if Is32Bit then
- begin
- if (Offset+3)>=RawRecord.RecordLength then
- internalerror(2015040504);
- TargetDisplacement := RawRecord.RawData[Offset]+
- (RawRecord.RawData[Offset+1] shl 8)+
- (RawRecord.RawData[Offset+2] shl 16)+
- (RawRecord.RawData[Offset+3] shl 24);
- Inc(Offset,4);
- end
- else
- begin
- if (Offset+1)>=RawRecord.RecordLength then
- internalerror(2015040504);
- TargetDisplacement := RawRecord.RawData[Offset]+
- (RawRecord.RawData[Offset+1] shl 8);
- Inc(Offset,2);
- end;
- end;
- Result:=Offset;
- end;
- function TOmfSubRecord_FIXUP.WriteAt(RawRecord: TOmfRawRecord; Offset: Integer): Integer;
- var
- Locat: Word;
- FixData: Byte;
- begin
- if (DataRecordOffset<0) or (DataRecordOffset>1023) then
- internalerror(2015040501);
- Locat:=$8000+(Ord(Mode) shl 14)+(Ord(LocationType) shl 10)+DataRecordOffset;
- { unlike other fields in the OMF format, this one is big endian }
- RawRecord.RawData[Offset]:=Byte(Locat shr 8);
- RawRecord.RawData[Offset+1]:=Byte(Locat);
- Inc(Offset, 2);
- FixData:=(Ord(FrameDeterminedByThread) shl 7)+(Ord(TargetDeterminedByThread) shl 3);
- if FrameDeterminedByThread then
- FixData:=FixData+(Ord(FrameThread) shl 4)
- else
- FixData:=FixData+(Ord(FrameMethod) shl 4);
- if TargetDeterminedByThread then
- FixData:=FixData+Ord(TargetThread)+(Ord(not TargetThreadDisplacementPresent) shl 2)
- else
- FixData:=FixData+Ord(TargetMethod);
- RawRecord.RawData[Offset]:=FixData;
- Inc(Offset);
- { save Frame Datum? }
- if not FrameDeterminedByThread and (FrameMethod in [ffmSegmentIndex,ffmGroupIndex,ffmExternalIndex,ffmFrameNumber]) then
- Offset:=RawRecord.WriteIndexedRef(Offset,FrameDatum);
- { save Target Datum? }
- if not TargetDeterminedByThread then
- Offset:=RawRecord.WriteIndexedRef(Offset,TargetDatum);
- { save Target Displacement? }
- if (TargetDeterminedByThread and TargetThreadDisplacementPresent) or
- (TargetMethod in [ftmSegmentIndex,ftmGroupIndex,ftmExternalIndex,ftmFrameNumber]) then
- begin
- if Is32Bit then
- begin
- RawRecord.RawData[Offset]:=Byte(TargetDisplacement);
- RawRecord.RawData[Offset+1]:=Byte(TargetDisplacement shr 8);
- RawRecord.RawData[Offset+2]:=Byte(TargetDisplacement shr 16);
- RawRecord.RawData[Offset+3]:=Byte(TargetDisplacement shr 24);
- Inc(Offset,4);
- end
- else
- begin
- if TargetDisplacement>$ffff then
- internalerror(2015040502);
- RawRecord.RawData[Offset]:=Byte(TargetDisplacement);
- RawRecord.RawData[Offset+1]:=Byte(TargetDisplacement shr 8);
- Inc(Offset,2);
- end;
- end;
- Result:=Offset;
- end;
- { TOmfRecord_LIBHEAD }
- constructor TOmfRecord_LIBHEAD.Create;
- begin
- PageSize:=512;
- DictionarySizeInBlocks:=2;
- CaseSensitive:=true;
- end;
- procedure TOmfRecord_LIBHEAD.SetPageSize(AValue: Integer);
- var
- p: longint;
- begin
- { valid library page sizes are powers of two, between 2**4 and 2**15 }
- if not ispowerof2(AValue,p) then
- internalerror(2015041802);
- if (p<4) or (p>15) then
- internalerror(2015041802);
- FPageSize:=AValue;
- end;
- procedure TOmfRecord_LIBHEAD.DecodeFrom(RawRecord: TOmfRawRecord);
- begin
- if RawRecord.RecordType<>RT_LIBHEAD then
- internalerror(2015040301);
- { this will also range check PageSize and will ensure that RecordLength>=13 }
- PageSize:=RawRecord.RecordLength+3;
- DictionaryOffset:=RawRecord.RawData[0]+
- (RawRecord.RawData[1] shl 8)+
- (RawRecord.RawData[2] shl 16)+
- (RawRecord.RawData[3] shl 24);
- DictionarySizeInBlocks:=RawRecord.RawData[4]+
- (RawRecord.RawData[5] shl 8);
- Flags:=RawRecord.RawData[6];
- end;
- procedure TOmfRecord_LIBHEAD.EncodeTo(RawRecord: TOmfRawRecord);
- begin
- { make sure the LIBHEAD record is padded with zeros at the end }
- FillChar(RawRecord.RawData,SizeOf(RawRecord.RawData),0);
- RawRecord.RecordType:=RT_LIBHEAD;
- RawRecord.RecordLength:=PageSize-3;
- RawRecord.RawData[0]:=Byte(DictionaryOffset);
- RawRecord.RawData[1]:=Byte(DictionaryOffset shr 8);
- RawRecord.RawData[2]:=Byte(DictionaryOffset shr 16);
- RawRecord.RawData[3]:=Byte(DictionaryOffset shr 24);
- RawRecord.RawData[4]:=Byte(DictionarySizeInBlocks);
- RawRecord.RawData[5]:=Byte(DictionarySizeInBlocks shr 8);
- RawRecord.RawData[6]:=Flags;
- { the LIBHEAD record contains no checksum byte, so no need to call
- RawRecord.CalculateChecksumByte }
- end;
- function TOmfRecord_LIBHEAD.IsCaseSensitive: Boolean;
- begin
- Result:=(FFlags and 1)<>0;
- end;
- procedure TOmfRecord_LIBHEAD.SetCaseSensitive(AValue: Boolean);
- begin
- FFlags:=(FFlags and $FE) or Ord(AValue);
- end;
- { TOmfRecord_LIBEND }
- procedure TOmfRecord_LIBEND.DecodeFrom(RawRecord: TOmfRawRecord);
- begin
- if RawRecord.RecordType<>RT_LIBEND then
- internalerror(2015040301);
- FPaddingBytes:=RawRecord.RecordLength;
- end;
- procedure TOmfRecord_LIBEND.EncodeTo(RawRecord: TOmfRawRecord);
- begin
- { make sure the LIBEND record is padded with zeros at the end }
- FillChar(RawRecord.RawData,SizeOf(RawRecord.RawData),0);
- RawRecord.RecordType:=RT_LIBEND;
- RawRecord.RecordLength:=FPaddingBytes;
- { the LIBEND record contains no checksum byte, so no need to call
- RawRecord.CalculateChecksumByte }
- end;
- procedure TOmfRecord_LIBEND.CalculatePaddingBytes(RecordStartOffset: DWord);
- var
- DictionaryStartOffset: Integer;
- begin
- { padding must be calculated, so that the dictionary begins on a 512-byte boundary }
- Inc(RecordStartOffset,3); // padding begins _after_ the record header (3 bytes)
- DictionaryStartOffset:=(RecordStartOffset+511) and $fffffe00;
- PaddingBytes:=DictionaryStartOffset-RecordStartOffset;
- end;
- function compute_omf_lib_hash(const name: string; blocks: Integer): TOmfLibHash;
- const
- blank=$20; // ASCII blank
- nbuckets=37;
- var
- block_x: Integer;
- block_d: Integer;
- bucket_x: Integer;
- bucket_d: Integer;
- len: Integer;
- pbidx,peidx: Integer;
- cback,cfront: Byte;
- begin
- len:=Length(name);
- if len=0 then
- internalerror(2015041801);
- pbidx:=1;
- peidx:=len+1;
- { left to right scan }
- block_x:=len or blank;
- bucket_d:=block_x;
- { right to left scan }
- block_d:=0;
- bucket_x:=0;
- while true do
- begin
- { blank -> convert to LC }
- Dec(peidx);
- cback:=Byte(name[peidx]) or blank;
- bucket_x:=RorWord(bucket_x,2) xor cback;
- block_d:=RolWord(block_d,2) xor cback;
- Dec(len);
- if len=0 then
- break;
- cfront:=Byte(name[pbidx]) or blank;
- Inc(pbidx);
- block_x:=RolWord(block_x,2) xor cfront;
- bucket_d:=RorWord(bucket_d,2) xor cfront;
- end;
- Result.block_x:=block_x mod blocks;
- Result.block_d:=max(block_d mod blocks,1);
- Result.bucket_x:=bucket_x mod nbuckets;
- Result.bucket_d:=max(bucket_d mod nbuckets,1);
- end;
- end.
|