(* This file was mangled by Mangler 1.35 (c) Copyright 1993-1994 by Berend de Boer *)
{ Created :
Interfacing unit to the Borland Debug Info appended to .exe files. With thanks
to Andy McFarland
Last changes :
93-12-04 Renamed TObjectClass to TClass
Moved GetLogicalAddr to BBUtil
93-12-11 Modules with no debug info (i.e. correlation records) broke
TDInfo. Now fixed.
}
{$IFDEF DPMI}
{$S-}
{$ENDIF}
{$IFDEF MsDos}
{$F+,O+}
{$ENDIF}
{$X+,R-,Q-,N+}
unit TDInfo;
interface
uses Objects, BBObject,
ObjMemory;
const
SmallDebugHeaderSize = 48; { size of debug header without extensions }
type
TDebugHeader = record
MagicNumber : word; { To be sure who we are ($52FB) }
MinorVersion : byte; { in case we change things }
MajorVersion : byte;
NamesPoolSize : longint; { names pool size in bytes }
NamesCount : word; { number of names in pool }
TypesCount : word; { number f type entries }
MembersCount : word; { structure members table }
SymbolsCount : word; { number of symbols }
GlobalsCount : word; { number of global symbols }
ModulesCount : word; { number of modules (units) }
LocalsCount : word; { optional; can be filler }
ScopesCount : word; { number of scopes in table }
LineNumbersCount : word; { number of line numbers }
SourceFilesCount : word; { number of include files }
SegmentsCount : word; { number of segment records }
CorrelationsCount : word; { number of segment/file correlations }
ImageSize : longint; { the number of bytes in the .EXE file }
{ if the uninitialized part of the data }
{ plus this debug info were removed; }
{ always zero in Pascal debug info }
DebuggerHook : pointer; { a far ptr into debugged program }
{ meaning depends on program flags. For }
{ pascal overlays, is ptr to start of }
{ data area that contains info about }
{ the overlays }
ProgramFlags : byte; { a byte of flags }
{ $00 = case sensitive link }
{ $01 = case insensitive link }
{ $02 = pascal overlay program }
StringSegOffse : integer; { no longer used }
DataCount : word; { size in bytes of data pool }
Filler1 : byte; { to force alignment }
ExtensionSize : integer; { 0, 16, or 32 for now }
ClassEntries, { number of classes }
ParentEntries,
GlobalEntries,
GlobalClasses,
OVerloadEntries,
ScopeClassEntries,
ModuleClassEntries,
CoverageOffsetCount : word;
NamePoolOffset : longint; { offse to start of name pool. This}
{ is relative to the symbols base }
BrowsersCount, { number of browser info recs }
OptSymEntries, { number of optional symbol records }
DebugFlags : word; { various flags }
Filler2 : array[1..8] of byte; { padding }
end;
const
scStatic = 0;
scAbsolute = 1;
scLocal = 2; { defined as sc_Auto in OAHfP }
scPasvar = 3;
stRegister = 4;
scConst = 5;
scTypeDef = 6;
scTag = 7;
const
tid_void = $00; { Unknown or no type }
tid_lstr = $01; { Basic literal string }
tid_dstr = $02; { Basic dynamic string }
tid_pstr = $03; { Pascal style string }
tid_sChar = $04; { Shortint }
tid_sInt = $05; { Integer }
tid_sLong = $06; { Longint }
tid_uChar = $08; { Byte }
tid_uInt = $09; { Word }
tid_PChar = $0C; { Char }
tid_Float = $0D; { IEEE 32-bit real }
tid_Tpreal = $0E; { Turbo Pascal 6-byte real }
tid_Double = $0F; { IEEE 64-bit real }
tid_Ldouble = $10; { IEEE 80-bit real }
tid_BCD4 = $11; { 4 byte BCD }
tid_BCD8 = $12; { 8 byte BCD }
tid_BCD10 = $13; { 10 byte BCD }
tid_BCDCOB = $14; { COBOL BCD }
tid_Near = $15; { Near pointer }
tid_Far = $16; { Far pointer }
tid_Seg = $17; { Segment pointer }
tid_Near386 = $18; { 386 32-bit offset ptr }
tid_Far386 = $19; { 386 48-bit far ptr }
tid_Parray = $1C; { Pascal array }
tid_Struct = $1E; { Structure }
tid_Union = $1F; { Union }
tid_ENUM = $22; { Enumerated type }
tid_Function = $23; { Function or procedure }
tid_Label = $24; { Goto label }
tid_SET = $25; { Pascal set }
tid_Tfile = $26; { Pascal text file }
tid_Bfile = $27; { Pascal binary file }
tid_Bool = $28; { Pascal boolean }
tid_Penum = $29; { Pascal enum }
tid_FuncPrototype = $2C; { Function with full parameter }
{ information }
tid_SpecialFunc = $2D; { Special function for methods and }
{ duplicate functions }
tid_Object = $2E; { Object }
tid_Nref = $34; { near reference pointer }
tid_Fref = $35; { far reference pointer }
tid_WordBool = $36; { Pascal word boolean }
tid_LongBool = $37; { Pascal long boolean }
tid_GlobalHandle = $3E; { Windows gloal handle }
tid_LocalHandle = $3F; { Windows local handle }
{ we use variables instead of real constants, because we don't have to think
about doing type conversions when multiplying integers }
const
SymbolRecordSize:longint = 9;
ModuleRecordSize:longint = 16;
SourceFileRecordSize:longint = 6;
LineNumberRecordSize:longint = 4;
ScopeRecordSize:longint = 12;
SegmentRecordSize:longint = 16;
CorrelationRecordSize:longint = 8;
TypeRecordSize:longint = 8;
MemberRecordSize:longint = 5;
ClassRecordSize:longint = 11;
ParentRecordSize:longint = 2;
OverloadRecordSize:longint = 8;
ScopeClassRecordSize:longint = 4;
ModuleClassRecordSize:longint = 4;
BrowserRecordSize:longint = 6;
type
{* pointer types *}
PSymbol = ^TSymbol;
PModule = ^TModule;
PSourceFile = ^TSourceFile;
PLineNumber = ^TLineNumber;
PScope = ^TScope;
PSegment = ^TSegment;
PCorrelation = ^TCorrelation;
PType = ^TType;
PMember = ^TMember;
PClass = ^TClass;
PBrowser = ^TBrowser;
{* objects *}
TSymbol = object(TObject)
Name : word;
TypeIndex : word;
Offset : word;
Segment : word;
Info : byte;
Index : word;
ModulePtr : PModule;
ScopePtr : PScope;
TypePtr : PType;
constructor Init(AIndex : word);
destructor Done; virtual;
constructor AtAddr(Addr : pointer);
constructor AtSegment(ASegment : PSegment; Addr : pointer);
procedure Get(AIndex : word);
function Class : word;
function HasValidBP : Boolean;
function ReturnAddressWordOffset : word;
function ItsModule : PModule;
function ItsName : string;
function ItsScope : PScope;
function ItsType : PType;
function ItsValueStr(StackFrame : word) : string;
function IsProcedure : Boolean;
end;
TModule = object(TObject)
Name : word;
Language : byte;
Flags : byte;
SymbolIndex : word;
SymbolCount : word;
SourceFileIndex : word;
SourceFileCount : word;
CorrelationIndex : word;
CorrelationCount : word;
Index : word;
constructor Init(AIndex : word);
procedure Get(AIndex : word);
function MemoryModel : word;
function ItsName : string;
procedure ForEachDSegElement(Action : pointer);
end;
TSourceFile = object(TObject)
Name : word;
TimeStamp : longint;
Index : word;
constructor Init(AIndex : word);
procedure Get(AIndex : word);
function ItsName : string;
end;
TLineNumber = object(TObject)
Value : word;
Offset : word;
CorrelationPtr : PCorrelation;
Index : word;
constructor Init(AIndex : word);
destructor Done; virtual;
constructor AtAddr(Addr : pointer);
procedure Get(AIndex : word);
function ItsCorrelation : PCorrelation;
end;
TScope = object(TObject)
SymbolIndex : word;
SymbolCount : word;
Parent : word;
FunctionSymbol : word;
Offset : word;
Length : word;
Index : word;
constructor Init(AIndex : word);
procedure Get(AIndex : word);
procedure ForEach(Action : pointer);
procedure ForEachParameter(Action : pointer);
procedure ForEachLocal(Action : pointer);
end;
TSegment = object(TObject)
ModuleIndex : word;
CodeSegment : word;
CodeOffset : word;
CodeLength : word;
ScopeIndex : word;
ScopeCount : word;
CorrelationIndex : word;
CorrelationCount : word;
Index : word;
ModulePtr : PModule;
constructor Init(AIndex : word);
destructor Done; virtual;
constructor AtAddr(Addr : pointer);
procedure Get(AIndex : word);
function ItsModule : PModule;
function FirstCorrelationThat(Test : pointer) : PCorrelation;
function FirstScopeThat(Test : pointer) : PScope;
end;
TCorrelation = object(TObject)
SegmentIndex : word;
SourceFileIndex : word;
LineNumberIndex : word;
LineNumberCount : word;
Index : word;
ModulePtr : PModule;
SegmentPtr : PSegment;
SourceFilePtr : PSourceFile;
constructor Init(AIndex : word);
destructor Done; virtual;
procedure Get(AIndex : word);
function ItsModule : PModule;
function ItsSegment : PSegment;
function ItsSourceFile : PSourceFile;
function SearchLineNumberOffset(Offset : word; var AIndex : word) : Boolean;
end;
TType = object(TObject)
ID : byte; { the tid byte }
Name : word; { any associated type name }
Size : word; { the size of any object of this type }
Filler : array[1..3+8] of byte;
Index : word;
ClassTypePtr : PType;
MemberPtr : PMember;
ReturnTypePtr : PType;
constructor Init(AIndex : word);
destructor Done; virtual;
function max_size : byte;
function enum_parent : word;
function enum_lower : word;
function enum_upper : word;
function enum_members : word;
procedure Get(AIndex : word);
function ItsClassType : PType;
function ItsName : string;
function ItsObject : PClass;
function ItsReturnType : PType;
function ItsValueStr(Addr : pointer) : string;
function Member(MemberIndex : word) : PMember;
function ReturnType : word;
end;
TMember = object(TObject)
Info : byte;
Name : word; { index of the name }
Value : word; { value of the corresponding name }
Index : word;
ItsTypePtr : PType;
constructor Init(AIndex :word);
destructor Done; virtual;
function EndOfStructure : Boolean;
procedure Get(AIndex : word);
function ItsName : string;
function ItsType : PType;
end;
TClass = object(TObject)
ParentIndex : word; { index into parent table }
ParentCount : word;
MemberIndex : word;
Name : word; { tag }
VirtualPtr : word; { offset from top of class data }
{ of virutal ptr }
Info : byte; { bit-mapped field }
Index : word;
constructor Init(AIndex :word);
procedure ForEachMember(Action : pointer);
procedure Get(AIndex : word);
function ItsName : string;
end;
TParent = record
ClassIndex : word; { index into class table }
end;
TOverload= record
FileIndex : word;
SourceLine : word;
LineOffset : word;
NameIndex : word; { name index to mangled name }
end;
TScopeClass = record
ClassIndex, { index into class table }
ClassCount : word; { number of classe }
end;
TModuleClass = record { local classes }
ClassIndex, { index into class table }
ClassCount : word; { number of classes }
end;
TBrowser = object(TObject)
SymbolIndex : word; { the index of the symbol in the }
{ Symbols table }
SourceFileIndex : word; { which file the symbol is in }
LineNumberIndex : word; { line number in the file }
Index : word;
LineNumberPtr : PLineNumber;
SourceFilePtr : PSourceFile;
SymbolPtr : PSymbol;
constructor Init(AIndex : word);
procedure Get(AIndex : word);
function ItsLineNumber : PLineNumber;
function ItsSourceFile : PSourceFile;
function ItsSymbol : PSymbol;
end;
type
PNames = ^TNames;
TNames = object(TObject)
arPool : PObjMemory;
arIndex : PObjMemory;
PoolOffset : longint;
CurrentIndex : longint;
constructor Init(PoolSize : longint; NamesCount : word);
destructor Done; virtual;
procedure Add(Index : word; const s : string);
function GetName(Index : word) : string;
end;
{* variables should be initialized with a call to TDInfoPresent *}
var
DebugHeader : TDebugHeader;
DebugInfoStart : longint;
SymbolsOffset : longint;
ModulesOffset : longint;
SourceFilesOffset : longint;
LineNumbersOffset : longint;
ScopesOffset : longint;
SegmentsOffset : longint;
CorrelationsOffset : longint;
TypesOffset : longint;
MembersOffset : longint;
ClassesOffset : longint;
ParentsOffset : longint;
ScopeClassesOffset : longint;
ModuleClassesOffset : longint;
BrowsersOffset : longint;
DataOffset : longint;
NamesOffset : longint;
const
DStream : PStream = nil;
Names : PNames = nil;
{* initialize unit *}
function TDInfoPresent(Stream : PStream) : Boolean;
IMPLEMENTATION USES {$IFDEF Windows}STRINGS , WINDOS , {$ELSE}DOS , {$ENDIF}BBERROR , BBFILE , BBUTIL ;
CONSTRUCTOR TNAMES.INIT (POOLSIZE:LONGINT;NAMESCOUNT:WORD);BEGIN INHERITED INIT;ARPOOL := GETOBJMEMORY (POOLSIZE , 0 ,
MEMFALL );ARINDEX := GETOBJMEMORY (LONGMUL (NAMESCOUNT , SIZEOF (LONGINT )), SIZEOF (LONGINT ), MEMFALL );IF (ARPOOL =NIL
)OR (ARINDEX =NIL )THEN FAIL ;END ;DESTRUCTOR TNAMES.DONE ;BEGIN DISCARD (ARINDEX );DISCARD (ARPOOL );INHERITED DONE;
END ;PROCEDURE TNAMES.ADD (INDEX:WORD;CONST S:STRING );BEGIN ARPOOL ^. MOVEFROM (S [ 1 ] , POOLOFFSET , LENGTH (S ));
ARINDEX ^. RECMOVEFROM (POOLOFFSET , CURRENTINDEX );INC (CURRENTINDEX );INC (POOLOFFSET , LENGTH (S ));END ;
FUNCTION TNAMES.GETNAME (INDEX:WORD):STRING ;VAR OO1O:STRING ;OI1OO00011O1,OI1OO00l1lII:LONGINT;BEGIN IF (INDEX =0 )OR
(INDEX > DEBUGHEADER.NAMESCOUNT )THEN GETNAME := 'Index '+ STRW (INDEX )+ ' is invalid -- TNames.GetName --'ELSE
BEGIN ARINDEX ^. RECMOVETO (INDEX - 1 , OI1OO00011O1 );IF INDEX =CURRENTINDEX THEN OI1OO00l1lII := POOLOFFSET ELSE
ARINDEX ^. RECMOVETO (INDEX , OI1OO00l1lII );OO1O [ 0 ] := CHR (OI1OO00l1lII - OI1OO00011O1 );ARPOOL ^. MOVETO
(OI1OO00011O1 , LENGTH (OO1O ), OO1O [ 1 ] );GETNAME := OO1O ;END ;END ;FUNCTION TDINFOPRESENT (STREAM:PSTREAM):BOOLEAN ;
TYPE OOO0OlI101=(UNKNOWN, PRESENT, NOTPRESENT);CONST O10O01011010O:OOO0OlI101=UNKNOWN;FUNCTION O1OO1I1Il00l :BOOLEAN ;
CONST O1lO01OlI1lO=512 ;VAR OO10:WORD;OIlO:WORD;OO1O:STRING ;OIOllI0O1OI,OI1OIIIl0lO1:LONGINT;O1010O1II0I01:WORD;
OOlIll0O0lll:ARRAY [ 1 .. O1lO01OlI1lO] OF CHAR;O10OIIlIlIlO1:WORD;BEGIN O1OO1I1Il00l := FALSE ;
WITH DEBUGHEADER DO BEGIN NAMES := NEW (PNAMES , INIT (NAMESPOOLSIZE , NAMESCOUNT ));IF NAMES =NIL THEN EXIT ;DSTREAM ^.
SEEK (NAMESOFFSET );OI1OIIIl0lO1 := DSTREAM ^. GETSIZE ;OIlO := 0 ;WHILE OIlO < NAMESCOUNT DO BEGIN OIOllI0O1OI :=
DSTREAM ^. GETPOS ;IF OIOllI0O1OI + O1lO01OlI1lO >= OI1OIIIl0lO1 THEN O1010O1II0I01 := OI1OIIIl0lO1 - OIOllI0O1OI ELSE
O1010O1II0I01 := O1lO01OlI1lO ;DSTREAM ^. READ (OOlIll0O0lll , O1010O1II0I01 );O10OIIlIlIlO1 := 1 ;REPEAT OO10 := SCANB
(@ OOlIll0O0lll [ O10OIIlIlIlO1 ] , O1lO01OlI1lO - O10OIIlIlIlO1 + 1 , 0 );IF OO10 =0 THEN BREAK ;MOVE (OOlIll0O0lll [
O10OIIlIlIlO1 ] , OO1O [ 1 ] , OO10 - 1 );OO1O [ 0 ] := CHR (OO10 - 1 );NAMES ^. ADD (OIlO , OO1O );INC (OIlO );INC
(O10OIIlIlIlO1 , OO10 );UNTIL (O10OIIlIlIlO1 >= O1lO01OlI1lO )OR (OIlO =NAMESCOUNT );DSTREAM ^. SEEK (OIOllI0O1OI +
O10OIIlIlIlO1 - 1 );END ;DSTREAM ^. RESET ;END ;O1OO1I1Il00l := TRUE ;END ;TYPE O10110ll11II1=RECORD O101l00011OO1:WORD;
Ol011l01O1:WORD;OI1lIOOl0l:WORD;O101l1011IOOO:WORD;O101l00lIl0:WORD;OOIOO1l0OIlO:WORD;O101l1I01OlI1:WORD;
O1011IO0Ol0OI:WORD;O1l11I0OlO:WORD;O1OOI11OIl1O:WORD;O1l0101OIIl1:WORD;OI0lO00ll0l1:ARRAY [ 1 .. 30 ] OF BYTE;
O10111011IIll:WORD;END ;OOI11lO00lO0=RECORD OlOO1OI0I1:WORD;CASE INTEGER OF 0 :(O101O1O1l00l1:WORD;O1010l0O10O11:WORD;
O100l0Ol0I01I:WORD);1 :(OOIlO11O1100:WORD;OOO0O110l0OI:LONGINT);END ;VAR OIOIOOI0OO1,OIOOlO1I0l1:BOOLEAN;
OOlIlOl0l0l1:OOI11lO00lO0;O10110OOOl1ll:O10110ll11II1;VAR OOIIlI0I1lI0:LONGINT;O101l00l1Ol10:LONGINT;
{$IFDEF Windows}OIlI1OlO00I:ARRAY [ 0 .. 127 ] OF CHAR;{$ENDIF}BEGIN TDINFOPRESENT := FALSE ;IF O10O01011010O <> UNKNOWN
THEN BEGIN TDINFOPRESENT := O10O01011010O =PRESENT ;EXIT ;END ;IF STREAM =NIL THEN BEGIN {$IFDEF Windows}DSTREAM := NEW
(PBUFSTREAM , INIT (STRPCOPY (OIlI1OlO00I , PARAMSTR (0 )), STOPEN + FMDENYNONE , 512 ));{$ELSE}DSTREAM := NEW
(PBUFSTREAM , INIT (PARAMSTR (0 ), STOPEN + FMDENYNONE , 512 ));{$ENDIF}IF (DSTREAM =NIL )OR (DSTREAM ^. STATUS <> STOK
)THEN BEGIN IF DSTREAM <> NIL THEN BEGIN LOGERROR ('Could not open executable. Status = '+ STRW (DSTREAM ^. STATUS )+
', '+ 'ErrorInfo = '+ STRI (DSTREAM ^. ERRORINFO )+ '.');IF (DSTREAM ^. STATUS =STINITERROR )AND (DSTREAM ^. ERRORINFO =4
)THEN LOGERROR ('Probably too many open files.');DISCARD (DSTREAM );END ;EXIT ;END ;END ELSE DSTREAM := STREAM ;
O101l00l1Ol10 := DSTREAM ^. GETPOS ;OIOIOOI0OO1 := FALSE ;REPEAT OIOOlO1I0l1 := TRUE ;IF O101l00l1Ol10 <= DSTREAM ^.
GETSIZE - SIZEOF (OOI11lO00lO0 )THEN BEGIN DSTREAM ^. SEEK (O101l00l1Ol10 );DSTREAM ^. READ (OOlIlOl0l0l1 , SIZEOF
(OOI11lO00lO0 ));CASE OOlIlOl0l0l1.OlOO1OI0I1 OF $5A4D :BEGIN DSTREAM ^. READ (O10110OOOl1ll , SIZEOF (O10110ll11II1 ));
IF O10110OOOl1ll.O1l11I0OlO >= $40 THEN O101l00l1Ol10 := O10110OOOl1ll.O10111011IIll ELSE INC (O101l00l1Ol10 , LONGMUL
(OOlIlOl0l0l1.O1010l0O10O11 , 512 )- (- OOlIlOl0l0l1.O101O1O1l00l1 AND 511 ));OIOOlO1I0l1 := FALSE ;END ;$454E
:BEGIN O101l00l1Ol10 := DSTREAM ^. GETSIZE - 8 ;OIOOlO1I0l1 := FALSE ;END ;$4246 :BEGIN OIOOlO1I0l1 := FALSE ;
CASE OOlIlOl0l0l1.OOIlO11O1100 OF $5250 :BEGIN HALT (1 );OIOIOOI0OO1 := TRUE ;OIOOlO1I0l1 := TRUE ;END ;$4C42 :DEC
(O101l00l1Ol10 , OOlIlOl0l0l1.OOO0O110l0OI - 8 );$4648 :DEC (O101l00l1Ol10 , SIZEOF (OOI11lO00lO0 )* 2 );ELSE OIOOlO1I0l1
:= TRUE ;END ;END ;$424E :IF OOlIlOl0l0l1.OOIlO11O1100 =$3230 THEN BEGIN DEC (O101l00l1Ol10 , OOlIlOl0l0l1.OOO0O110l0OI
);INC (O101l00l1Ol10 , 16 + 8 );OIOIOOI0OO1 := TRUE ;OIOOlO1I0l1 := TRUE ;END ;$52FB :BEGIN OIOOlO1I0l1 := TRUE ;
OIOIOOI0OO1 := TRUE ;END ;$4246 :IF OOlIlOl0l0l1.OOIlO11O1100 =$5250 THEN HALT (1 )ELSE BEGIN INC (O101l00l1Ol10 ,
OOlIlOl0l0l1.OOO0O110l0OI + 8 );OIOOlO1I0l1 := FALSE ;END ;END ;END ;UNTIL OIOOlO1I0l1 ;IF OIOIOOI0OO1 THEN
BEGIN DEBUGINFOSTART := O101l00l1Ol10 ;DSTREAM ^. SEEK (DEBUGINFOSTART );FILLCHAR (DEBUGHEADER , SIZEOF (TDEBUGHEADER ),
0 );DSTREAM ^. READ (DEBUGHEADER , SMALLDEBUGHEADERSIZE );IF DEBUGHEADER.EXTENSIONSIZE <> 0 THEN DSTREAM ^. READ
(DEBUGHEADER.CLASSENTRIES , DEBUGHEADER.EXTENSIONSIZE );SYMBOLSOFFSET := DSTREAM ^. GETPOS ;
WITH DEBUGHEADER DO BEGIN MODULESOFFSET := SYMBOLSOFFSET + LONGINT (SYMBOLSCOUNT )* SYMBOLRECORDSIZE ;SOURCEFILESOFFSET
:= MODULESOFFSET + LONGINT (MODULESCOUNT )* MODULERECORDSIZE ;LINENUMBERSOFFSET := SOURCEFILESOFFSET + LONGINT
(SOURCEFILESCOUNT )* SOURCEFILERECORDSIZE ;SCOPESOFFSET := LINENUMBERSOFFSET + LONGINT (LINENUMBERSCOUNT )*
LINENUMBERRECORDSIZE ;SEGMENTSOFFSET := SCOPESOFFSET + LONGINT (SCOPESCOUNT )* SCOPERECORDSIZE ;CORRELATIONSOFFSET :=
SEGMENTSOFFSET + LONGINT (SEGMENTSCOUNT )* SEGMENTRECORDSIZE ;TYPESOFFSET := CORRELATIONSOFFSET + LONGINT
(CORRELATIONSCOUNT )* CORRELATIONRECORDSIZE ;MEMBERSOFFSET := TYPESOFFSET + LONGINT (TYPESCOUNT )* TYPERECORDSIZE ;
CLASSESOFFSET := MEMBERSOFFSET + LONGINT (MEMBERSCOUNT )* MEMBERRECORDSIZE ;PARENTSOFFSET := CLASSESOFFSET + LONGINT
(CLASSENTRIES )* CLASSRECORDSIZE ;SCOPECLASSESOFFSET := PARENTSOFFSET + LONGINT (PARENTENTRIES )* PARENTRECORDSIZE +
LONGINT (OVERLOADENTRIES )* OVERLOADRECORDSIZE ;MODULECLASSESOFFSET := SCOPECLASSESOFFSET + LONGINT (SCOPECLASSENTRIES )*
SCOPECLASSRECORDSIZE ;BROWSERSOFFSET := MODULECLASSESOFFSET + LONGINT (MODULECLASSENTRIES )* MODULECLASSRECORDSIZE ;
DATAOFFSET := BROWSERSOFFSET + LONGINT (BROWSERSCOUNT )* BROWSERRECORDSIZE ;NAMESOFFSET := DATAOFFSET + DATACOUNT ;
OIOIOOI0OO1 := O1OO1I1Il00l ;END ;END ;IF OIOIOOI0OO1 THEN O10O01011010O := PRESENT ELSE O10O01011010O := NOTPRESENT ;
TDINFOPRESENT := OIOIOOI0OO1 ;END ;CONSTRUCTOR TSYMBOL.INIT (AINDEX:WORD);BEGIN INHERITED INIT;GET (AINDEX );END ;
DESTRUCTOR TSYMBOL.DONE ;BEGIN DISCARD (MODULEPTR );DISCARD (SCOPEPTR );DISCARD (TYPEPTR );INHERITED DONE;END ;
CONSTRUCTOR TSYMBOL.ATADDR (ADDR:POINTER);FUNCTION O1Ol1OO1lOIl (OI11l0OIll00:PSCOPE):BOOLEAN ;FAR;BEGIN O1Ol1OO1lOIl :=
(OI11l0OIll00 ^. OFFSET <= PTRREC (ADDR ). OFS )AND (OI11l0OIll00 ^. OFFSET + OI11l0OIll00 ^. LENGTH >= PTRREC (ADDR ).
OFS );END ;VAR O1010l00IOO11:PSEGMENT;OI11l0OIll00:PSCOPE;OIlO:INTEGER;BEGIN INHERITED INIT;NEW (O1010l00IOO11 , ATADDR
(ADDR ));IF O1010l00IOO11 =NIL THEN FAIL ;OI11l0OIll00 := O1010l00IOO11 ^. FIRSTSCOPETHAT (@ O1Ol1OO1lOIl );IF
OI11l0OIll00 =NIL THEN BEGIN DISPOSE (O1010l00IOO11 , DONE );FAIL ;END ;IF (OI11l0OIll00 ^. FUNCTIONSYMBOL =$FFFF )OR
(OI11l0OIll00 ^. FUNCTIONSYMBOL =$FEEE )THEN FAIL ;GET (OI11l0OIll00 ^. FUNCTIONSYMBOL );SCOPEPTR := OI11l0OIll00 ;
DISPOSE (O1010l00IOO11 , DONE );END ;CONSTRUCTOR TSYMBOL.ATSEGMENT (ASEGMENT:PSEGMENT;ADDR:POINTER);
FUNCTION O1Ol1OO1lOIl (OI11l0OIll00:PSCOPE):BOOLEAN ;FAR;BEGIN O1Ol1OO1lOIl := (OI11l0OIll00 ^. OFFSET <= PTRREC (ADDR ).
OFS )AND (OI11l0OIll00 ^. OFFSET + OI11l0OIll00 ^. LENGTH >= PTRREC (ADDR ). OFS );END ;VAR OI11l0OIll00:PSCOPE;
OIlO:INTEGER;BEGIN INHERITED INIT;OI11l0OIll00 := ASEGMENT ^. FIRSTSCOPETHAT (@ O1Ol1OO1lOIl );IF OI11l0OIll00 =NIL THEN
FAIL ;IF (OI11l0OIll00 ^. FUNCTIONSYMBOL =$FFFF )OR (OI11l0OIll00 ^. FUNCTIONSYMBOL =$FEEE )THEN FAIL ;GET (OI11l0OIll00
^. FUNCTIONSYMBOL );SCOPEPTR := OI11l0OIll00 ;END ;PROCEDURE TSYMBOL.GET (AINDEX:WORD);BEGIN INDEX := AINDEX ;DSTREAM ^.
SEEK (SYMBOLSOFFSET + (INDEX - 1 )* SYMBOLRECORDSIZE );DSTREAM ^. READ (NAME , SYMBOLRECORDSIZE );END ;
FUNCTION TSYMBOL.CLASS :WORD ;BEGIN CLASS := (INFO AND $7 );END ;FUNCTION TSYMBOL.HASVALIDBP :BOOLEAN ;BEGIN HASVALIDBP
:= (INFO AND $10 )<> 0 END ;FUNCTION TSYMBOL.RETURNADDRESSWORDOFFSET :WORD ;BEGIN RETURNADDRESSWORDOFFSET := (INFO AND
$E0 )SHR 5 ;END ;FUNCTION TSYMBOL.ITSMODULE :PMODULE ;BEGIN IF MODULEPTR =NIL THEN ABSTRACT ;ITSMODULE := MODULEPTR ;
END ;FUNCTION TSYMBOL.ITSNAME :STRING ;BEGIN ITSNAME := NAMES ^. GETNAME (NAME );END ;FUNCTION TSYMBOL.ITSSCOPE :PSCOPE ;
BEGIN IF SCOPEPTR =NIL THEN ABSTRACT ;ITSSCOPE := SCOPEPTR ;END ;FUNCTION TSYMBOL.ITSTYPE :PTYPE ;BEGIN IF (TYPEPTR =NIL
)AND (TYPEINDEX <> TID_VOID )THEN NEW (TYPEPTR , INIT (TYPEINDEX ));ITSTYPE := TYPEPTR ;END ;
FUNCTION TSYMBOL.ITSVALUESTR (STACKFRAME:WORD):STRING ;VAR OOlIl0OOIIOO:POINTER;BEGIN IF TYPEINDEX =TID_VOID THEN
BEGIN ITSVALUESTR := '';EXIT ;END ;CASE CLASS OF SCSTATIC :OOlIl0OOIIOO := PTR (DSEG , OFFSET );SCABSOLUTE :OOlIl0OOIIOO
:= PTR (SEGMENT , OFFSET );SCLOCAL :OOlIl0OOIIOO := PTR (SSEG , STACKFRAME + OFFSET );SCPASVAR :OOlIl0OOIIOO := POINTER
(PTR (SSEG , STACKFRAME + OFFSET )^);ELSE LOGERROR ('Not yet supported class: $'+ HEXSTR (CLASS )+
' -- TSymbol.ItsValueStr--');END ;IF OOlIl0OOIIOO =NIL THEN ITSVALUESTR := '!!'+ ITSNAME + ' = nil!!'ELSE ITSVALUESTR :=
ITSTYPE ^. ITSVALUESTR (OOlIl0OOIIOO );END ;FUNCTION TSYMBOL.ISPROCEDURE :BOOLEAN ;BEGIN ISPROCEDURE := ITSTYPE ^. ID IN
[ TID_FUNCTION , TID_FUNCPROTOTYPE , TID_SPECIALFUNC ] END ;CONSTRUCTOR TMODULE.INIT (AINDEX:WORD);VAR OOII:WORD;
OI11l0OIll00:PSCOPE;BEGIN INHERITED INIT;GET (AINDEX );NEW (OI11l0OIll00 , INIT (AINDEX ));SYMBOLINDEX := OI11l0OIll00 ^.
SYMBOLINDEX ;SYMBOLCOUNT := OI11l0OIll00 ^. SYMBOLCOUNT ;DISPOSE (OI11l0OIll00 , DONE );END ;PROCEDURE TMODULE.GET
(AINDEX:WORD);BEGIN INDEX := AINDEX ;DSTREAM ^. SEEK (MODULESOFFSET + (INDEX - 1 )* MODULERECORDSIZE );DSTREAM ^. READ
(NAME , MODULERECORDSIZE );END ;FUNCTION TMODULE.MEMORYMODEL :WORD ;BEGIN MEMORYMODEL := FLAGS AND $E ;END ;
FUNCTION TMODULE.ITSNAME :STRING ;BEGIN ITSNAME := NAMES ^. GETNAME (NAME );END ;PROCEDURE TMODULE.FOREACHDSEGELEMENT
(ACTION:POINTER);VAR OIlO:WORD;OIOOO0O0I1l:PSYMBOL;BEGIN FOR OIlO := SYMBOLINDEX TO SYMBOLINDEX + SYMBOLCOUNT - 1
DO BEGIN NEW (OIOOO0O0I1l , INIT (OIlO ));IF (OIOOO0O0I1l <> NIL )AND (OIOOO0O0I1l ^. CLASS =SCSTATIC )AND ((OIOOO0O0I1l
^. ITSTYPE =NIL )OR NOT (OIOOO0O0I1l ^. ITSTYPE ^. ID IN [ TID_FUNCTION , TID_SPECIALFUNC ] ))THEN BEGIN ASM {}
LES DI , OIOOO0O0I1l{} PUSH ES {} PUSH DI {} {$IFDEF Windows} {} MOV AX , [ BP ] {} AND AL , 0feh {} PUSH AX {}
{$ELSE} {} PUSH WORD PTR [ BP ] {} {$ENDIF} {} CALL DWORD PTR ACTION{} END;END ;DISCARD (OIOOO0O0I1l );END ;END ;
CONSTRUCTOR TSOURCEFILE.INIT (AINDEX:WORD);BEGIN INHERITED INIT;GET (AINDEX );END ;PROCEDURE TSOURCEFILE.GET
(AINDEX:WORD);BEGIN INDEX := AINDEX ;DSTREAM ^. SEEK (SOURCEFILESOFFSET + (INDEX - 1 )* SOURCEFILERECORDSIZE );DSTREAM ^.
READ (NAME , SOURCEFILERECORDSIZE );END ;FUNCTION TSOURCEFILE.ITSNAME :STRING ;BEGIN ITSNAME := NAMES ^. GETNAME (NAME );
END ;CONSTRUCTOR TLINENUMBER.INIT (AINDEX:WORD);BEGIN INHERITED INIT;GET (AINDEX );END ;DESTRUCTOR TLINENUMBER.DONE ;
BEGIN DISCARD (CORRELATIONPTR );INHERITED DONE;END ;CONSTRUCTOR TLINENUMBER.ATADDR (ADDR:POINTER);VAR OIIl0OO0Il:WORD;
FUNCTION O1Ol1OO1lOIl (O10OIIOl11lI1:PCORRELATION):BOOLEAN ;FAR;BEGIN O1Ol1OO1lOIl := O10OIIOl11lI1 ^.
SEARCHLINENUMBEROFFSET (PTRREC (ADDR ). OFS , OIIl0OO0Il );END ;VAR OI0011l0I1:PSEGMENT;O10OIIOl11lI1:PCORRELATION;
BEGIN INHERITED INIT;NEW (OI0011l0I1 , ATADDR (ADDR ));IF (OI0011l0I1 =NIL )OR (OI0011l0I1 ^. CORRELATIONCOUNT =0 )THEN
BEGIN DISCARD (OI0011l0I1 );FAIL ;END ;O10OIIOl11lI1 := OI0011l0I1 ^. FIRSTCORRELATIONTHAT (@ O1Ol1OO1lOIl );IF
O10OIIOl11lI1 =NIL THEN FAIL ;GET (OIIl0OO0Il );CORRELATIONPTR := O10OIIOl11lI1 ;DISPOSE (OI0011l0I1 , DONE );END ;
PROCEDURE TLINENUMBER.GET (AINDEX:WORD);BEGIN INDEX := AINDEX ;DSTREAM ^. SEEK (LINENUMBERSOFFSET + (INDEX - 1 )*
LINENUMBERRECORDSIZE );DSTREAM ^. READ (VALUE , LINENUMBERRECORDSIZE );END ;FUNCTION TLINENUMBER.ITSCORRELATION
:PCORRELATION ;BEGIN IF CORRELATIONPTR =NIL THEN ABSTRACT ;ITSCORRELATION := CORRELATIONPTR ;END ;
CONSTRUCTOR TSCOPE.INIT (AINDEX:WORD);BEGIN INHERITED INIT;GET (AINDEX );END ;PROCEDURE TSCOPE.GET (AINDEX:WORD);
BEGIN INDEX := AINDEX ;DSTREAM ^. SEEK (SCOPESOFFSET + (INDEX - 1 )* SCOPERECORDSIZE );DSTREAM ^. READ (SYMBOLINDEX ,
SCOPERECORDSIZE );END ;PROCEDURE TSCOPE.FOREACH (ACTION:POINTER);VAR OIlO:INTEGER;OIOOO0O0I1l:PSYMBOL;BEGIN FOR OIlO :=
SYMBOLINDEX TO SYMBOLINDEX + SYMBOLCOUNT - 1 DO BEGIN NEW (OIOOO0O0I1l , INIT (OIlO ));ASM {} LES DI , OIOOO0O0I1l{}
PUSH ES {} PUSH DI {} {$IFDEF Windows} {} MOV AX , [ BP ] {} AND AL , 0feh
