uses
DbgInfo;
function MyName: String;
var
Offset: DWord;
di : TDebugInfomation;
begin
Result := '';
di := TDebugInfomation.Create(ParamStr(0));
try
di.Analyse;
Offset := DWord(@MyName) - GetModuleHandle(nil) - $1000;
Result := di.OffsetToProc(Offset).Name;
finally
FreeAndNil(di);
end;
end;
procedure TForm19.Button1Click(Sender: TObject);
begin
ShowMessage(MyName);
end;
(**
* Analyse Symbolic Debugging Information for Borland 32 bit symbol file
*
* Author : Flier Lu
* EMail : flier_lu@yahoo.com
* Date : 2001.9.16
* Version : 0.1
* Copyrights : The authors grant you the right to modify the source code
* as long as the original authors are mentionned.
* Please let us know if you make any improvements,
* so that I can keep an up to date version.
* We also welcome all comments, preferably by email.
* History : 2001.9.16 - v0.1 - First release for Delphi 6
* 2001.9.18 - v0.2 - Analyse dependence between modules,
* source files, procedures, etc.
* Fix a bug about the NameIndex, all NameIn
dex
* is begin with 1 but Delphi use 0
**)
unit DbgInfo
interface
uses
Windows, Classes, SysUtils, Contnrs
const
MaxArraySize = MaxInt div 16 - 1
type
PArrayOfByte = ^TArrayOfByte
TArrayOfByte = array[0..MaxArraySize] of Byte
PArrayOfWord = ^TArrayOfWord
TArrayOfWord = array[0..MaxArraySize] of Word
PArrayOfPointer = ^TArrayOfPointer
TArrayOfPointer = array[0..MaxArraySize] of PArrayOfByte
{ [-----------------------------------------------------------------------]
[ Symbol and Type OMF Format Borland Executable Files ]
[-----------------------------------------------------------------------]
Introduction
This section describes the format used to embed debugging information into
the executable file.
Debug Information Format
The format encompasses a block of data which goes at the end of the .EXE
file, i.e., after the header plus load image, overlays, and
Windows/Presentation Manager resource compiler information. The lower
portion of the file is unaffected by the additional data.
The last eight bytes of the file contain a signature and a long file offset
from the end of the file (lfoBase). The signature is FBxx, where xx is the
version number. The long offset indicates the position in the file
(relative to the end of the file) of the base address. For the LX format
executables, the base address is determined by looking at the executable
header.
The signatures have the following meanings:
FB09 The signature for a Borland 32 bit symbol file.
The value
lfaBase=length of the file - lfoBase
gives the base address of the start of the Symbol and Type OMF information
relative to the beginning of the file. All other file offsets in the
Symbol and Type OMF are relative to the lfaBase. At the base address the
signature is repeated, followed by the long displacement to the subsection
directory (lfoDir). All subsections start on a long word boundary and are
designed to maintain natural alignment internally in each subsection and
within the subsection directory.
Subsection Directory
The subsection directory has the format
Directory header
Directory entry 0
Directory entry 1
.
.
.
Directory entry n
There is no requirement for a particular subsection of a particular module
to exist.
The following is the layout of the FB09 debug information in the image:
FB09 Header
sstModule [1]
.
.
.
sstModule [n]
sstAlignSym [1]
sstSrcModule [1]
.
.
.
sstAlignSym [n]
sstSrcModule [n]
sstGlobalSym
sstGlobalTypes
sstNames
SubSection Directory
FB09 Trailer
}
const
Borland32BitSymbolFileSignature = $FB09
// The signature for a Borland 32 bit symbol file.
type
PFileSignature = ^TFileSignature;
TFileSignature = packed record
Signature, // The signature for a Borland 32 bit symbol file.
Offset: DWord
// a long file offset from the end of the file
end;
// Subsection Types
const
SUBSECTION_TYPE_MODULE = $120;
SUBSECTION_TYPE_TYPES = $121;
SUBSECTION_TYPE_SYMBOLS = $124;
SUBSECTION_TYPE_ALIGN_SYMBOLS = $125;
SUBSECTION_TYPE_SOURCE_MODULE = $127;
SUBSECTION_TYPE_GLOBAL_SYMBOLS = $129;
SUBSECTION_TYPE_GLOBAL_TYPES = $12B;
SUBSECTION_TYPE_NAMES = $130;
type
{ The directory header structure is followed by the directory entries
which specify the subsection type, module index, file offset, and size.
The subsection directory gives the location (LFO) and size of each subsection,
as well as its type and module number if applicable. }
PDirectoryEntry = ^TDirectoryEntry;
TDirectoryEntry = packed record
SubsectionType, // Subdirectory type
ModuleIndex: Word
// Module index
Offset, // Offset from the base offset lfoBase
Size: DWord
// Number of bytes in subsection
end;
{ The subsection directory is prefixed with a directory header structure
indicating size and number of subsection directory entries that follow.
}
PDirectoryHeader = ^TDirectoryHeader;
TDirectoryHeader = packed record
Size, // Length of this structure
DirEntrySize: Word
// Length of each directory entry
DirEntryCount, // Number of directory entries
lfoNextDir, // Offset from lfoBase of next directory.
Flags: DWord
// Flags describing directory and subsection tables.
//DirEntries: array[0..0] of TDirectoryEntry;
end;
{
SUBSECTION_TYPE_MODULE 0x120
This describes the basic information about an object module including code
segments, module name, and the number of segments for the modules that
follow. Directory entries for sstModules precede all other subsection
directory entries.
}
type
PSegmentInfo = ^TSegmentInfo;
TSegmentInfo = packed record
Segment, // Segment that this structure describes
Flags: Word
// Attributes for the logical segment.
// The following attributes are defined:
// 0x0000 Data segment
// 0x0001 Code segment
Offset, // Offset in segment where the code starts
Size: DWord
// Count of the number of bytes of code in the segment
end;
PModuleInfo = ^TModuleInfo;
TModuleInfo = packed record
OverlayNumber, // Overlay number
LibraryIndex, // Index into sstLibraries subsection
// if this module was linked from a library
SegmentCount, // Count of the number of code segments
// this module contributes to
DebuggingStyle: Word
// Debugging style for this module.
NameIndex, // Name index of module.
TimeStamp: DWord
// Time stamp from the OBJ file.
Reserved: array[0..2] of DWord
// Set to 0.
Segments: array[0..MaxArraySize] of TSegmentInfo;
(*
{ Detailed information about each segment that code
is contributed to. This is an array of cSeg count
segment information descriptor structures. }
Segments: array[0..SegmentCount - 1] of TSegmentInfo;
*)
end;
{ SUBSECTION_TYPE_MODULE 0x0127
This table describes the source line number to addressing mapping
information for a module. The table permits the description of a module
containing multiple source files with each source file contributing code to
one or more code segments. The base addresses of the tables described
below are all relative to the beginning of the sstSrcModule table.
Module header
Information for source file 1
Information for segment 1
.
.
.
Information for segment n
.
.
.
Information for source file n
Information for segment 1
.
.
.
Information for segment n
}
type
{ The line number to address mapping information is contained in a table with
the following format: }
PLineMappingEntry = ^TLineMappingEntry;
TLineMappingEntry = packed record
SegmentIndex, // Segment index for this table
PairCount: Word
// Count of the number of source line pairs to follow
Offsets: array[0..MaxArraySize] of DWord;
(*
{ An array of 32-bit offsets for the offset within the code segment of
the start of ine contained in the parallel array linenumber. }
Offsets: array[0..PairCount - 1] of DWord;
{ This is an array of 16-bit line numbers of the lines in the source file
that cause code to be emitted to the code segment.
This array is parallel to the offset array.
If cPair is not even, then a zero word is emitted to
maintain natural alignment in the sstSrcModule table. }
LineNumbers: array[0..PairCount - 1] of Word;
*)
end;
TOffsetPair = packed record
StartOffset,
EndOffset: DWord;
end;
{ The file table describes the code segments that receive code from this
source file. Source file entries have the following format: }
PSourceFileEntry = ^TSourceFileEntry;
TSourceFileEntry = packed record
SegmentCount: Word
// Number of segments that receive code from this source file.
NameIndex: Integer
// Name index of Source file name.
BaseSrcLines: array[0..MaxArraySize] of DWord;
(*
{ An array of offsets for the line/address mapping
tables for each of the segments that receive code
from this source file. }
BaseSrcLines: array[0..SegmentCount - 1] of DWord;
{ An array of two 32-bit offsets per segment that
receives code from this module. The first offset
is the offset within the segment of the first byte
of code from this module. The second offset is the
ending address of the code from this module. The
order of these pairs corresponds to the ordering of
the segments in the seg array. Zeros in these
entries means that the information is not known and
the file and line tables described below need to be
examined to determine if an address of interest is
contained within the code from this module. }
SegmentAddress: array[0..SegmentCount - 1] of TOffsetPair;
Name: ShortString
// Count of the number of bytes in source file name
*)
end;
{ The module header structure describes the source file and code segment
organization of the module. Each module header has the following format:
}
PSourceModuleInfo = ^TSourceModuleInfo;
TSourceModuleInfo = packed record
FileCount, // The number of source file scontributing code to segments
SegmentCount: Word
// The number of code segments receiving code from this module
BaseSrcFiles: array[0..MaxArraySize] of DWord;
(*
// This is an array of base offsets from the beginning of the sstSrcModule table
BaseSrcFiles: array[0..FileCount - 1] of DWord;
{ An array of two 32-bit offsets per segment that
receives code from this module. The first offset
is the offset within the segment of the first byte
of code from this module. The second offset is the
ending address of the code from this module. The
order of these pairs corresponds to the ordering of
the segments in the seg array. Zeros in these
entries means that the information is not known and
the file and line tables described below need to be
examined to determine if an address of interest is
contained within the code from this module. }
SegmentAddress: array[0..SegmentCount - 1] of TOffsetPair;
{ An array of segment indices that receive code from
this module. If the number of segments is not
even, a pad word is inserted to maintain natural
alignment. }
SegmentIndexes: array[0..SegmentCount - 1] of Word;
*)
end;
{ SUBSECTION_TYPE_GLOBAL_TYPES 0x12b
This subsection contains the packed type records for the executable file.
The first long word of the subsection contains the number of types in the
table. This count is followed by a count-sized array of long offsets to
the corresponding type record. As the sstGlobalTypes subsection is
written, each type record is forced to start on a long word boundary.
However, the length of the type string is NOT adjusted by the pad count.
The remainder of the subsection contains the type records.
}
type
PGlobalTypeInfo = ^TGlobalTypeInfo;
TGlobalTypeInfo = packed record
Count: DWord
// count of the number of types
// offset of each type string from the beginning of table
Offsets: array[0..MaxArraySize] of DWord;
end;
{ Symbol type defines }
const
SYMBOL_TYPE_COMPILE = $0001
// Compile flags symbol
SYMBOL_TYPE_REGISTER = $0002
// Register variable
SYMBOL_TYPE_CONST = $0003
// Constant symbol
SYMBOL_TYPE_UDT = $0004
// User-defined Type
SYMBOL_TYPE_SSEARCH = $0005
// Start search
SYMBOL_TYPE_END = $0006
// End block, procedure, with, or thunk
SYMBOL_TYPE_SKIP = $0007
// Skip - Reserve symbol space
SYMBOL_TYPE_CVRESERVE = $0008
// Reserved for Code View internal use
SYMBOL_TYPE_OBJNAME = $0009
// Specify name of object file
SYMBOL_TYPE_BPREL16 = $0100
// BP relative 16:16
SYMBOL_TYPE_LDATA16 = $0101
// Local data 16:16
SYMBOL_TYPE_GDATA16 = $0102
// Global data 16:16
SYMBOL_TYPE_PUB16 = $0103
// Public symbol 16:16
SYMBOL_TYPE_LPROC16 = $0104
// Local procedure start 16:16
SYMBOL_TYPE_GPROC16 = $0105
// Global procedure start 16:16
SYMBOL_TYPE_THUNK16 = $0106
// Thunk start 16:16
SYMBOL_TYPE_BLOCK16 = $0107
// Block start 16:16
SYMBOL_TYPE_WITH16 = $0108
// With start 16:16
SYMBOL_TYPE_LABEL16 = $0109
// Code label 16:16
SYMBOL_TYPE_CEXMODEL16 = $010A
// Change execution model 16:16
SYMBOL_TYPE_VFTPATH16 = $010B
// Virtual function table path descriptor 16:16
SYMBOL_TYPE_BPREL32 = $0200
// BP relative 16:32
SYMBOL_TYPE_LDATA32 = $0201
// Local data 16:32
SYMBOL_TYPE_GDATA32 = $0202
// Global data 16:32
SYMBOL_TYPE_PUB32 = $0203
// Public symbol 16:32
SYMBOL_TYPE_LPROC32 = $0204
// Local procedure start 16:32
SYMBOL_TYPE_GPROC32 = $0205
// Global procedure start 16:32
SYMBOL_TYPE_THUNK32 = $0206
// Thunk start 16:32
SYMBOL_TYPE_BLOCK32 = $0207
// Block start 16:32
SYMBOL_TYPE_WITH32 = $0208
// With start 16:32
SYMBOL_TYPE_LABEL32 = $0209
// Label 16:32
SYMBOL_TYPE_CEXMODEL32 = $020A
// Change execution model 16:32
SYMBOL_TYPE_VFTPATH32 = $020B
// Virtual function table path descriptor 16:32
{
Compile Flag
SYMBOL_TYPE_COMPILE 0x0001
This symbol communicates to Code View compile time information on
a per module basis, such as the language and version number of the compiler,
the ambient model for code and data, and the target processor.
Flags - flags showing compile time options:
PCodePresent :1
FloatPrecision :2
FloatPackage :2
AmbientData :3
AmbientCode :3
Mode32 :1 Compiled for 32 bit addresses
chsign :1 True is 'char' is a signed type
Reserved :3
Ambient code and data memory model enumeration
0 Near
1 Far
2 Huge
3-7 Reserved
Floating package enumeration
0 Hardware processor (80x87 for Intel 80x86 processors)
1 Emulator
2 Altmath
3 Reserved
The FloatPrecision flag is set to 1 if the -OP option was enabled during
the compilation.
}
const
COMPILE_MACHINE_INTEL_8080 = $00;
COMPILE_MACHINE_INTEL_8086 = $01;
COMPILE_MACHINE_INTEL_80286 = $02;
COMPILE_MACHINE_INTEL_80386 = $03;
COMPILE_MACHINE_INTEL_80486 = $04;
COMPILE_MACHINE_MIPS_R4000 = $10;
COMPILE_LANGUAGE_C = 0;
COMPILE_LANGUAGE_CPP = 1;
COMPILE_LANGUAGE_FORTRAN = 2;
COMPILE_LANGUAGE_MASM = 3;
COMPILE_LANGUAGE_PASCAL = 4;
COMPILE_LANGUAGE_BASIC = 5;
COMPILE_LANGUAGE_COBOL = 6;
COMPILE_FLOATING_PACKAGE_HARDWARE = 0;
COMPILE_FLOATING_PACKAGE_EMULATOR = 1;
COMPILE_FLOATING_PACKAGE_ALTMATH = 2;
COMPILE_MEMORY_MODEL_NEAR = 0;
COMPILE_MEMORY_MODEL_FAR = 1;
COMPILE_MEMORY_MODEL_HUGE = 2;
type
TSymbolCompileInfo = packed record
Machine,
Language: Byte;
Flags: Word;
Version: ShortString;
end;
{
Global and Local Procedure Start 16:32
SYMBOL_TYPE_LPROC32 0x0204
S_GPROC32 0x0205
The symbol records define local (file static) and global procedure
definition. For C/C++, functions that are declared static to a module are
emitted as Local Procedure symbols. Functions not specifically declared
static are emitted as Global Procedures. For each S_GPROC32 emitted,
an S_GPROCREF symbol must be fabricated and emitted to the sstGlobalSym section.
}
type
TSymbolProcInfo = packed record
pParent,
pEnd,
pNext,
Size, // Length in bytes of this procedure
DebugStart, // Offset in bytes from the start of the procedure to
// the point where the stack frame has been set up.
DebugEnd, // Offset in bytes from the start of the procedure to
// the point where the procedure is ready to return
// and has calculated its return value, if any.
// Frame and register variables an still be viewed.
Offset:DWord
// Offset portion of the segmented address of
// the start of the procedure in the code segment
Segment: Word
// Segment portion of the segmented address of
// the start of the procedure in the code segment
ProcType: DWord
// Type of the procedure type record
NearFar, // Type of return the procedure makes:
// 0 near
// 4 far
Reserved: Byte;
NameIndex: DWord
// Name index of procedure
end;
type
PSymbolInfo = ^TSymbolInfo;
TSymbolInfo = packed record
Size,
SymbolType: Word;
case Word of
SYMBOL_TYPE_COMPILE: ( Compile: TSymbolCompileInfo
);
SYMBOL_TYPE_LPROC32,
SYMBOL_TYPE_GPROC32: ( Proc: TSymbolProcInfo
);
end;
PSymbolInfos = ^TSymbolInfos;
TSymbolInfos = packed record
Signature: DWord;
Symbols: array[0..0] of TSymbolInfo;
end;
type
TSegmentType = (stData, stCode);
TSegment = class
private
FSegmentType: TSegmentType;
FOffset,
FSize: DWord;
public
constructor Create(const ASegmentType: TSegmentType
const AOffset, ASize: DWord);
property SegmentType: TSegmentType read FSegmentType;
property Offset: DWord read FOffset;
property Size: DWord read FSize;
end;
TDebugInfomation = class;
TSourceFile = class;
TSymbolProc = class;
TModule = class
private
FOwner: TDebugInfomation;
FNameIndex: Integer;
FSegments,
FProcs: TObjectList;
function GetName: string;
function GetSegment(const Index: Integer): TSegment;
function GetSegmentCount: Integer;
function GetProc(const Index: Integer): TSymbolProc;
function GetProcCount: Integer;
protected
FSourceFile: TSourceFile;
function AddSegment(const ASegment: TSegment): Integer;
function AddProc(const AProc: TSymbolProc): Integer;
property NameIndex: Integer read FNameIndex;
public
constructor Create(const AOwner: TDebugInfomation
const ANameIndex: Integer);
destructor Destroy
override;
function IsContainOffset(const AOffset: DWord): Boolean;
function OffsetToProc(const AOffset: DWord): TSymbolProc;
property Owner: TDebugInfomation read FOwner;
property SourceFile: TSourceFile read FSourceFile;
property Name: string read GetName;
property Segment[const Index: Integer]: TSegment read GetSegment;
property SegmentCount: Integer read GetSegmentCount;
property Proc[const Index: Integer]: TSymbolProc read GetProc;
property ProcCount: Integer read GetProcCount;
end;
TLineAddress = class
private
FOffset: DWord;
FLineNo: Integer;
public
constructor Create(const AOffset: DWord
const ALineNo: Integer);
property Offset: DWord read FOffset;
property LineNo: Integer read FLineNo;
end;
TSourceFile = class
private
FOwner: TDebugInfomation;
FNameIndex: Integer;
FAddresses: TObjectList;
function GetName: string;
function GetAddress(const Index: Integer): TLineAddress;
function GetAddressCount: Integer;
protected
FModule: TModule;
function AddAddress(const AAddress: TLineAddress): Integer;
property NameIndex: Integer read FNameIndex;
public
constructor Create(const AOwner: TDebugInfomation
const ANameIndex: Integer);
destructor Destroy
override;
function OffsetToLineAddress(const AOffset: DWord): TLineAddress;
function OffsetToLineNo(const AOffset: DWord): Integer;
function LineNoToOffset(const ALineNo: Integer): DWord;
property Owner: TDebugInfomation read FOwner;
property Module: TModule read FModule;
property Name: string read GetName;
property Address[const Index: Integer]: TLineAddress read GetAddress;
property AddressCount: Integer read GetAddressCount;
end;
TSymbol = class
private
FOwner: TDebugInfomation;
FSymbolType: Word;
protected
procedure Analyse(const pInfo: PSymbolInfo)
virtual
abstract;
public
constructor Create(const AOwner: TDebugInfomation
const pInfo: PSymbolInfo);
property SymbolType: Word read FSymbolType;
end;
TCompileMachine = (cm8080, cm8086, cm80286, cm80386, cm80486, cmR4K, cmUnknown);
TCompileLanguage = (clC, clCpp, clFortran, clMasm, clPascal, clBasic, clCobol, clUnknown);
TCompileFloatPackage = (fpHardware, fpEmulator, fpAltmath, fpUnknown);
TCompileMemoryModel = (mmNear, mmFar, mmHuge, mmUnknown);
TSymbolCompile = class(TSymbol)
private
FMachine: TCompileMachine;
FLanguage: TCompileLanguage;
FPCodePresent: Boolean;
FFloatPrecision: Byte;
FFloatPackage: TCompileFloatPackage;
FAmbientData: TCompileMemoryModel;
FAmbientCode: TCompileMemoryModel;
FMode32: Boolean;
FCharSign: Boolean;
FVersion: string;
protected
procedure Analyse(const pInfo: PSymbolInfo)
override;
public
property Machine: TCompileMachine read FMachine;
property Language: TCompileLanguage read FLanguage;
property PCodePresent: Boolean read FPCodePresent;
property FloatPrecision: Byte read FFloatPrecision;
property FloatPackage: TCompileFloatPackage read FFloatPackage;
property AmbientData: TCompileMemoryModel read FAmbientData;
property AmbientCode: TCompileMemoryModel read FAmbientCode;
property Mode32: Boolean read FMode32;
property CharSign: Boolean read FCharSign;
property Version: string read FVersion;
end;
TSymbolProc = class(TSymbol)
private
FNameIndex: Integer;
FOffset,
FSize: DWord;
function GetName: string;
protected
FModule: TModule;
procedure Analyse(const pInfo: PSymbolInfo)
override;
property NameIndex: Integer read FNameIndex;
public
function IsContainOffset(const AOffset: DWord): Boolean;
property Module: TModule read FModule;
property Name: string read GetName;
property Offset: DWord read FOffset;
property Size: DWord read FSize;
end;
TSymbolLocalProc = class(TSymbolProc);
TSymbolGlobalProc = class(TSymbolProc);
TDebugInfomation = class
private
FFileName: TFileName;
FFileSize: DWord;
m_hFile,
m_hFileMapping: THandle;
m_pBaseAddr: Pointer;
m_lfaBase: DWord
// the base address of the start of
// the Symbol and Type OMF information
// relative to the beginning of the file
FTypes,
FNames: TStringList;
FSymbols,
FModules,
FSourceFiles: TObjectList;
function IsBorland32BitSymbolFileSignature(const Signature: DWord): Boolean;
function GetSymbol(const Index: Integer): TSymbol;
function GetSymbolCount: Integer;
function GetModule(const Index: Integer): TModule;
function GetModuleCount: Integer;
function GetSourceFile(const Index: Integer): TSourceFile;
function GetSourceFileCount: Integer;
protected
procedure AnalyseModules(const pModInfo: PModuleInfo);
procedure AnalyseTypes(const pSubsection: Pointer);
procedure AnalyseSymbols(const pSubsection: Pointer);
procedure AnalyseAlignSymbols(const pSymbols: PSymbolInfos
const Size: DWord);
procedure AnalyseSourceModules(const pSrcModInfo: PSourceModuleInfo);
procedure AnalyseGlobalSymbols(const pSubsection: Pointer);
procedure AnalyseGlobalTypes(const pTypes: PGlobalTypeInfo);
procedure AnalyseNames(const pSubsection: Pointer);
procedure AnalyseDependence;
public
constructor Create(const AFileName: TFileName);
destructor Destroy
override;
procedure Analyse;
function OffsetToModule(const AOffset: DWord): TModule;
function OffsetToProc(const AOffset: DWord): TSymbolProc;
function OffsetToLineAddress(const AOffset: DWord): TLineAddress;
function OffsetToLineNo(const AOffset: DWord): Integer;
property FileName: TFileName read FFileName;
property FileSize: DWord read FFileSize;
property Types: TStringList read FTypes;
property Names: TStringList read FNames;
property Symbol[const Index: Integer]: TSymbol read GetSymbol;
property SymbolCount: Integer read GetSymbolCount;
property Module[const Index: Integer]: TModule read GetModule;
property ModuleCount: Integer read GetModuleCount;
property SourceFile[const Index: Integer]: TSourceFile read GetSourceFile;
property SourceFileCount: Integer read GetSourceFileCount;
end;
implementation
{$WARN SYMBOL_DEPRECATED OFF}
{$WARN SYMBOL_PLATFORM OFF}
resourcestring
SFileNotExist = 'The file %s is not exist!';
SFileHasNotDbgInfo = 'The file %s has not debug infomation!';
{ TSegment }
constructor TSegment.Create(const ASegmentType: TSegmentType;
const AOffset, ASize: DWord);
begin
inherited Create;
FSegmentType := ASegmentType;
FOffset := AOffset;
FSize := ASize;
end;
{ TModule }
constructor TModule.Create(const AOwner: TDebugInfomation
const ANameIndex: Integer);
begin
Assert(Assigned(AOwner));
Assert(ANameIndex > 0);
inherited Create;
FOwner := AOwner;
FNameIndex := ANameIndex;
FSegments := TObjectList.Create;
FProcs := TObjectList.Create(False);
FSourceFile := nil;
end;
destructor TModule.Destroy;
begin
FProcs.Free;
FSegments.Free;
inherited;
end;
function TModule.GetName: string;
begin
Result := FOwner.Names[FNameIndex - 1];
end;
function TModule.GetSegment(const Index: Integer): TSegment;
begin
Assert((Index >= 0) and (Index < FSegments.Count));
Result := FSegments.Items[Index] as TSegment;
end;
function TModule.GetSegmentCount: Integer;
begin
Result := FSegments.Count;
end;
function TModule.AddSegment(const ASegment: TSegment): Integer;
begin
Assert(Assigned(ASegment));
Result := FSegments.Add(ASegment);
end;
function TModule.GetProc(const Index: Integer): TSymbolProc;
begin
Assert((Index >= 0) and (Index < FProcs.Count));
Result := FProcs.Items[Index] as TSymbolProc;
end;
function TModule.GetProcCount: Integer;
begin
Result := FProcs.Count;
end;
function TModule.AddProc(const AProc: TSymbolProc): Integer;
begin
Assert(Assigned(AProc));
Result := FProcs.Add(AProc);
end;
function TModule.IsContainOffset(const AOffset: DWord): Boolean;
var
I: Integer;
begin
for I := 0 to SegmentCount - 1 do
if Segment[I].SegmentType = stCode then
if (Segment[I].Offset <= AOffset) and
(AOffset < (Segment[I].Offset + Segment[I].Size)) then
begin
Result := True;
Exit;
end;
Result := False;
end;
function TModule.OffsetToProc(const AOffset: DWord): TSymbolProc;
var
I: Integer;
begin
for I := 0 to ProcCount - 1 do
if Proc[I].IsContainOffset(AOffset) then
begin
Result := Proc[I];
Exit;
end;
Result := nil;
end;
{ TLineAddress }
constructor TLineAddress.Create(const AOffset: DWord
const ALineNo: Integer);
begin
inherited Create;
FOffset := AOffset;
FLineNo := ALineNo;
end;
{ TSourceFile }
constructor TSourceFile.Create(const AOwner: TDebugInfomation
const ANameIndex: Integer);
begin
Assert(Assigned(AOwner));
Assert(ANameIndex > 0);
inherited Create;
FOwner := AOwner;
FNameIndex := ANameIndex;
FAddresses := TObjectList.Create;
FModule := nil;
end;
destructor TSourceFile.Destroy;
begin
FAddresses.Free;
inherited;
end;
function TSourceFile.GetName: string;
begin
Result := FOwner.Names[FNameIndex - 1];
end;
function TSourceFile.GetAddress(const Index: Integer): TLineAddress;
begin
Assert((Index >= 0) and (Index < FAddresses.Count));
Result := FAddresses.Items[Index] as TLineAddress;
end;
function TSourceFile.GetAddressCount: Integer;
begin
Result := FAddresses.Count;
end;
function TSourceFile.AddAddress(const AAddress: TLineAddress): Integer;
begin
Assert(Assigned(AAddress));
Result := FAddresses.Add(AAddress);
end;
function TSourceFile.OffsetToLineAddress(const AOffset: DWord): TLineAddress;
var
I: Integer;
begin
Assert(AddressCount > 0);
Result := nil;
if AOffset < Address[0].Offset then
Exit;
for I := 1 to AddressCount - 1 do
if (Address[I - 1].Offset <= AOffset) and (AOffset < Address[I].Offset)
then
begin
Result := Address[I - 1];
Break;
end;
end;
function TSourceFile.OffsetToLineNo(const AOffset: DWord): Integer;
var
ALineAddr: TLineAddress;
begin
ALineAddr := OffsetToLineAddress(AOffset);
if Assigned(ALineAddr) then
Result := ALineAddr.LineNo
else
Result := -1;
end;
function TSourceFile.LineNoToOffset(const ALineNo: Integer): DWord;
var
I: Integer;
begin
for I := 0 to AddressCount - 1 do
if Address[I].LineNo = ALineNo then
begin
Result := Address[I].Offset;
Exit;
end;
Result := DWord(-1);
end;
{ TSymbol }
constructor TSymbol.Create(const AOwner: TDebugInfomation
const pInfo: PSymbolInfo);
begin
inherited Create;
FOwner := AOwner;
Analyse(pInfo);
end;
{ TSymbolCompile }
procedure TSymbolCompile.Analyse(const pInfo: PSymbolInfo);
begin
Assert(pInfo.SymbolType = SYMBOL_TYPE_COMPILE);
case pInfo.Compile.Machine of
COMPILE_MACHINE_INTEL_8080: FMachine := cm8080;
COMPILE_MACHINE_INTEL_8086: FMachine := cm8086;
COMPILE_MACHINE_INTEL_80286: FMachine := cm80286;
COMPILE_MACHINE_INTEL_80386: FMachine := cm80386;
COMPILE_MACHINE_INTEL_80486: FMachine := cm80486;
COMPILE_MACHINE_MIPS_R4000: FMachine := cmR4K;
else
FMachine := cmUnknown;
end;
case pInfo.Compile.Language of
COMPILE_LANGUAGE_C: FLanguage := clC;
COMPILE_LANGUAGE_CPP: FLanguage := clCpp;
COMPILE_LANGUAGE_FORTRAN: FLanguage := clFortran;
COMPILE_LANGUAGE_MASM: FLanguage := clMasm;
COMPILE_LANGUAGE_PASCAL: FLanguage := clPascal;
COMPILE_LANGUAGE_BASIC: FLanguage := clBasic;
COMPILE_LANGUAGE_COBOL: FLanguage := clCobol;
else
FLanguage := clUnknown;
end;
FPCodePresent := (pInfo.Compile.Flags and $0001) <> 0
// 1 bit from 0 bit
FFloatPrecision := (pInfo.Compile.Flags and $0006) shr 1
// 2 bit from 1 bit
case (pInfo.Compile.Flags and $0018) shr 3 of // 2 bit from 3 bit
COMPILE_FLOATING_PACKAGE_HARDWARE: FFloatPackage := fpHardware;
COMPILE_FLOATING_PACKAGE_EMULATOR: FFloatPackage := fpEmulator;
COMPILE_FLOATING_PACKAGE_ALTMATH: FFloatPackage := fpAltmath;
else
FFloatPackage := fpUnknown;
end;
case (pInfo.Compile.Flags and $00E0) shr 5 of // 3 bit from 5 bit
COMPILE_MEMORY_MODEL_NEAR: FAmbientData := mmNear;
COMPILE_MEMORY_MODEL_FAR: FAmbientData := mmFar;
COMPILE_MEMORY_MODEL_HUGE: FAmbientData := mmHuge;
else
FAmbientData := mmUnknown;
end;
case (pInfo.Compile.Flags and $0700) shr 8 of // 3 bit from 8 bit
COMPILE_MEMORY_MODEL_NEAR: FAmbientCode := mmNear;
COMPILE_MEMORY_MODEL_FAR: FAmbientCode := mmFar;
COMPILE_MEMORY_MODEL_HUGE: FAmbientCode := mmHuge;
else
FAmbientCode := mmUnknown;
end;
FMode32 := (pInfo.Compile.Flags and $0800) <> 0
// 1 bit from 11 bit
FCharSign := (pInfo.Compile.Flags and $1000) <> 0
// 1 bit from 12 bit
FVersion := pInfo.Compile.Version;
end;
{ TSymbolProc }
function TSymbolProc.GetName: string;
begin
Result := FOwner.Names[FNameIndex - 1];
end;
procedure TSymbolProc.Analyse(const pInfo: PSymbolInfo);
begin
FNameIndex := pInfo.Proc.NameIndex;
FOffset := pInfo.Proc.Offset;
FSize := pInfo.Proc.Size;
FModule := nil;
end;
function TSymbolProc.IsContainOffset(const AOffset: DWord): Boolean;
begin
Result := (FOffset <= AOffset) and (AOffset < (FOffset + FSize));
end;
{ TDebugInfomation }
constructor TDebugInfomation.Create(const AFileName: TFileName);
var
pFileSign: PFileSignature;
begin
inherited Create;
FFileName := ExpandFileName(AFileName);
// Check the file is exist ?
if not FileExists(FFileName) then
raise Exception.CreateFmt(SFileNotExist, [FFileName]);
// Open the file for read
m_hFile := CreateFile(PChar(FFileName), GENERIC_READ, FILE_SHARE_READ,
nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
if m_hFile = INVALID_HANDLE_VALUE then
RaiseLastWin32Error;
// Get the file size
FFileSize := GetFileSize(m_hFile, nil);
if FFileSize = INVALID_FILE_SIZE then
RaiseLastWin32Error;
// Create the file mapping handle for read only
m_hFileMapping := CreateFileMapping(m_hFile, nil, PAGE_READONLY,
0, FFileSize, nil);
if m_hFileMapping = 0 then
RaiseLastWin32Error;
// Map the file to memory for read
m_pBaseAddr := MapViewOfFile(m_hFileMapping, FILE_MAP_READ, 0, 0, 0);
if m_pBaseAddr = nil then
RaiseLastWin32Error;
// Check the debug information is exist ?
pFileSign := PFileSignature(DWord(m_pBaseAddr) + FFileSize - SizeOf(TFileSignature));
if IsBorland32BitSymbolFileSignature(pFileSign.Signature) then
raise Exception.CreateFmt(SFileHasNotDbgInfo, [FFileName]);
// Calculate the base address of the start of the Symbol and Type OMF information
m_lfaBase := DWord(m_pBaseAddr) + FFileSize - pFileSign.Offset;
// Check the debug information is exist ?
pFileSign := PFileSignature(m_lfaBase);
if IsBorland32BitSymbolFileSignature(pFileSign.Signature) then
raise Exception.CreateFmt(SFileHasNotDbgInfo, [FFileName]);
FTypes := TStringList.Create;
FNames := TStringList.Create;
FSymbols := TObjectList.Create;
FModules := TObjectList.Create;
FSourceFiles := TObjectList.Create;
end;
destructor TDebugInfomation.Destroy;
begin
FSourceFiles.Free;
FModules.Free;
FSymbols.Free;
FNames.Free;
FTypes.Free;
Assert(m_hFile <> INVALID_HANDLE_VALUE);
Assert(m_hFileMapping <> 0);
Assert(m_pBaseAddr <> nil);
Win32Check(UnmapViewOfFile(m_pBaseAddr));
Win32Check(CloseHandle(m_hFileMapping));
Win32Check(CloseHandle(m_hFile));
inherited;
end;
function TDebugInfomation.IsBorland32BitSymbolFileSignature(const Signature:
DWord): Boolean;
begin
Result := Signature = Borland32BitSymbolFileSignature;
end;
function TDebugInfomation.GetSymbol(const Index: Integer): TSymbol;
begin
Assert((Index >= 0) and (Index < FSymbols.Count));
Result := FSymbols.Items[Index] as TSymbol;
end;
function TDebugInfomation.GetSymbolCount: Integer;
begin
Result := FSymbols.Count;
end;
function TDebugInfomation.GetModule(const Index: Integer): TModule;
begin
Assert((Index >= 0) and (Index < FModules.Count));
Result := FModules.Items[Index] as TModule;
end;
function TDebugInfomation.GetModuleCount: Integer;
begin
Result := FModules.Count;
end;
function TDebugInfomation.GetSourceFile(const Index: Integer): TSourceFile;
begin
Assert((Index >= 0) and (Index < FSourceFiles.Count));
Result := FSourceFiles.Items[Index] as TSourceFile;
end;
function TDebugInfomation.GetSourceFileCount: Integer;
begin
Result := FSourceFiles.Count;
end;
procedure TDebugInfomation.AnalyseModules(const pModInfo: PModuleInfo);
const
SegmentTypes: array[0..1] of TSegmentType = (stData, stCode);
var
I: Integer;
Module: TModule;
begin
Module := TModule.Create(Self, pModInfo.NameIndex);
FModules.Add(Module);
for I := 0 to pModInfo.SegmentCount - 1 do
with pModInfo.Segments[I] do
Module.AddSegment(TSegment.Create(SegmentTypes[Flags], Offset, Size));
end;
procedure TDebugInfomation.AnalyseTypes(const pSubsection: Pointer);
begin
end;
procedure TDebugInfomation.AnalyseSymbols(const pSubsection: Pointer);
begin
end;
procedure TDebugInfomation.AnalyseAlignSymbols(const pSymbols: PSymbolInfos;
const Size: DWord);
var
Offset: DWord;
pInfo: PSymbolInfo;
Symbol: TSymbol;
begin
Offset := DWord(@pSymbols.Symbols[0]) - DWord(pSymbols);
while Offset < Size do
begin
pInfo := PSymbolInfo(DWord(pSymbols) + Offset);
case pInfo.SymbolType of
SYMBOL_TYPE_COMPILE: Symbol := TSymbolCompile.Create(Self, pInfo);
SYMBOL_TYPE_LPROC32: Symbol := TSymbolLocalProc.Create(Self, pInfo);
SYMBOL_TYPE_GPROC32: Symbol := TSymbolGlobalProc.Create(Self, pInfo);
else
Symbol := nil;
end;
if Assigned(Symbol) then
FSymbols.Add(Symbol);
Inc(Offset, pInfo.Size + SizeOf(pInfo.Size));
end;
end;
procedure TDebugInfomation.AnalyseSourceModules(const pSrcModInfo: PSourceModuleInfo);
var
I, J, K, Offset, LineNo: Integer;
pSrcFile: PSourceFileEntry;
SourceFile: TSourceFile;
pLineEntry: PLineMappingEntry;
begin
for I := 0 to pSrcModInfo.FileCount - 1 do
begin
pSrcFile := PSourceFileEntry(DWord(pSrcModInfo) + pSrcModInfo.BaseSrcFiles[I]);
if pSrcFile.NameIndex > 0 then
begin
SourceFile := TSourceFile.Create(Self, pSrcFile.NameIndex);
FSourceFiles.Add(SourceFile);
for J := 0 to pSrcFile.SegmentCount - 1 do
begin
pLineEntry := PLineMappingEntry(DWord(pSrcModInfo) + pSrcFile.BaseSrcLines[J]);
for K := 0 to pLineEntry.PairCount - 1 do
begin
Offset := pLineEntry.Offsets[K];
LineNo := PArrayOfWord(@pLineEntry.Offsets[pLineEntry.PairCount])^[K];
SourceFile.AddAddress(TLineAddress.Create(Offset, LineNo));
end;
end;
end;
end;
end;
procedure TDebugInfomation.AnalyseGlobalSymbols(const pSubsection: Pointer);
begin
end;
procedure TDebugInfomation.AnalyseGlobalTypes(const pTypes: PGlobalTypeInfo);
begin
end;
procedure TDebugInfomation.AnalyseNames(const pSubsection: Pointer);
var
I, Count, Len: Integer;
pszName: PChar;
begin
Count := PDWord(pSubsection)^;
pszName := PChar(DWord(pSubsection) + SizeOf(DWord));
FNames.BeginUpdate;
try
for I := 0 to Count - 1 do
begin
// Get the length of the name
Len := Ord(pszName^);
Inc(pszName);
// Get the name
FNames.Add(pszName);
// skip the length of name and a NULL at the end
Inc(pszName, Len + 1);
end;
finally
FNames.EndUpdate;
end;
end;
procedure TDebugInfomation.AnalyseDependence;
var
I, J: Integer;
AMod: TModule;
ASrc: TSourceFile;
AProc: TSymbolProc;
begin
// Analyse the dependence between modules and source files
for I := 0 to ModuleCount - 1 do
begin
AMod := Module[I];
if Assigned(AMod.SourceFile) then
Continue;
for J := 0 to SourceFileCount - 1 do
begin
ASrc := SourceFile[J];
if Assigned(ASrc.Module) then
Continue;
Assert(ASrc.AddressCount > 0);
if AMod.IsContainOffset(ASrc.Address[0].Offset) then
begin
AMod.FSourceFile := ASrc;
ASrc.FModule := AMod;
Break;
end;
end;
end;
// Analyse the dependence between modules and procedures
for I := 0 to SymbolCount - 1 do
begin
if Symbol[I].InheritsFrom(TSymbolProc) then
begin
AProc := Symbol[I] as TSymbolProc;
for J := 0 to ModuleCount - 1 do
begin
AMod := Module[J];
if AMod.IsContainOffset(AProc.Offset) then
begin
AMod.FProcs.Add(AProc);
AProc.FModule := AMod;
Break;
end;
end;
end;
end;
end;
procedure TDebugInfomation.Analyse;
var
I: Integer;
pDirHeader: PDirectoryHeader;
pDirEntry: PDirectoryEntry;
pSubsection: Pointer;
begin
pDirHeader := PDirectoryHeader(m_lfaBase + PFileSignature(m_lfaBase).Offset);
for I := 0 to pDirHeader.DirEntryCount - 1 do
begin
pDirEntry := PDirectoryEntry(DWord(pDirHeader) + pDirHeader.Size +
DWord(pDirHeader.DirEntrySize * I));
pSubsection := Pointer(m_lfaBase + pDirEntry.Offset);
case pDirEntry.SubsectionType of
SUBSECTION_TYPE_MODULE: AnalyseModules(pSubsection);
SUBSECTION_TYPE_TYPES: AnalyseTypes(pSubsection);
SUBSECTION_TYPE_SYMBOLS: AnalyseSymbols(pSubsection);
SUBSECTION_TYPE_ALIGN_SYMBOLS: AnalyseAlignSymbols(pSubsection, pDirEntry.Size);
SUBSECTION_TYPE_SOURCE_MODULE: AnalyseSourceModules(pSubsection);
SUBSECTION_TYPE_GLOBAL_SYMBOLS: AnalyseGlobalSymbols(pSubsection);
SUBSECTION_TYPE_GLOBAL_TYPES: AnalyseGlobalTypes(pSubsection);
SUBSECTION_TYPE_NAMES: AnalyseNames(pSubsection);
else
OutputDebugString(PChar(Format('Unknown Subsection Type 0x%x!', [pDirEntry.SubsectionType])));
end;
end;
AnalyseDependence;
end;
function TDebugInfomation.OffsetToModule(const AOffset: DWord): TModule;
var
I: Integer;
begin
for I := 0 to ModuleCount - 1 do
if Module[I].IsContainOffset(AOffset) then
begin
Result := Module[I];
Exit;
end;
Result := nil;
end;
function TDebugInfomation.OffsetToProc(const AOffset: DWord): TSymbolProc;
var
AMod: TModule;
begin
AMod := OffsetToModule(AOffset);
if Assigned(AMod) then
Result := AMod.OffsetToProc(AOffset)
else
Result := nil;
end;
function TDebugInfomation.OffsetToLineAddress(const AOffset: DWord): TLineAddress;
var
AMod: TModule;
begin
AMod := OffsetToModule(AOffset);
if Assigned(AMod) and Assigned(AMod.SourceFile) then
Result := AMod.SourceFile.OffsetToLineAddress(AOffset)
else
Result := nil;
end;
function TDebugInfomation.OffsetToLineNo(const AOffset: DWord): Integer;
var
ALineAddr: TLineAddress;
begin
ALineAddr := OffsetToLineAddress(AOffset);
if Assigned(ALineAddr) then
Result := ALineAddr.LineNo
else
Result := -1;
end;
end.
