unit DCURecs;
(*
The DCU records module of the DCU32INT utility by Alexei Hmelnov.
It contains classes for representation of DCU declarations and
definitions in memory. 
----------------------------------------------------------------------------
E-Mail: alex@icc.ru
http://hmelnov.icc.ru/DCU/
----------------------------------------------------------------------------

See the file "readme.txt" for more details.

------------------------------------------------------------------------
                             IMPORTANT NOTE:
This software is provided 'as-is', without any expressed or implied warranty.
In no event will the author be held liable for any damages arising from the
use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented, you must not
   claim that you wrote the original software.
2. Altered source versions must be plainly marked as such, and must not
   be misrepresented as being the original software.
3. This notice may not be removed or altered from any source
   distribution.
*)
interface

uses
  SysUtils, Classes, DCU_In, DCU_Out, DasmDefs, FixUp;

type
{ Auxiliary data types }

PLocVarRec = ^TLocVarRec;
TLocVarRec = record
  sym: integer; //Symbol # in the symbol table, 0 - proc data end
  ofs: integer; //Offset in procedure code
  frame: integer; //-1(0x7f)-symbol end, else - symbol start 0-EAX, 1-EDX,
    //2-ECX, 3-EBX, 4-ESI...
end ;

PLocVarTbl = ^TLocVarTbl;
TLocVarTbl = array[Word] of TLocVarRec;

TDeclListKind = (dlMain,dlMainImpl,dlArgs,dlArgsT,dlEmbedded,dlFields,
  dlClass,dlInterface,dlDispInterface,dlUnitAddInfo);

TDeclSecKind = (skNone,skLabel,skConst,skType,skVar,skThreadVar,skResStr,
  skExport,skProc,skPrivate,skProtected,skPublic,skPublished);

type

PTDCURec = ^TDCURec;
TDCURec = class
  Next: TDCURec;
  function GetName: PName; virtual; abstract;
  function SetMem(MOfs,MSz: Cardinal): Cardinal {Rest}; virtual;
  function NameIsUnique: boolean; virtual;
  procedure ShowName; virtual; abstract;
  procedure Show; virtual; abstract;
  property Name: PName read GetName;
end ;

TBaseDef = class(TDCURec)
  FName: PName;
  Def: PDef;
  hUnit: integer;
  constructor Create(AName: PName; ADef: PDef; AUnit: integer);
  procedure ShowName; override;
  procedure Show; override;
  procedure ShowNamed(N: PName);
  function GetName: PName; override;
  function SetMem(MOfs,MSz: Cardinal): Cardinal {Rest}; override;
end ;

TImpKind=Char;

TImpDef = class(TBaseDef)
  ik: TImpKind;
  FNameIsUnique: boolean;
//  ImpRec: TDCURec;
  Inf: integer;
  constructor Create(AIK: TImpKind; AName: PName; AnInf: integer; ADef: PDef; AUnit: integer);
  procedure Show; override;
//  procedure GetImpRec;
  function NameIsUnique: boolean; override;
end ;

TDLLImpRec = class(TBaseDef{TImpDef})
  NDX: integer;
  constructor Create(AName: PName; ANDX: integer; ADef: PDef; AUnit: integer);
  procedure Show; override;
end ;

TImpTypeDefRec = class(TImpDef{TBaseDef})
  RTTIOfs,RTTISz: Cardinal; //L: Byte;
  hImpUnit: integer;
  ImpName: PName;
  constructor Create(AName: PName; AnInf: integer; ARTTISz: Cardinal{AL: Byte}; ADef: PDef; AUnit: integer);
  procedure Show; override;
  function SetMem(MOfs,MSz: Cardinal): Cardinal {Rest}; override;
end ;

type

TNameDecl = class(TDCURec)
  Def: PNameDef;
  hDecl: integer;
  constructor Create0;
  constructor Create;
  destructor Destroy; override;
  procedure ShowName; override;
  procedure Show; override;
  procedure ShowDef(All: boolean); virtual;
  function GetName: PName; override;
  function SetMem(MOfs,MSz: Cardinal): Cardinal {Rest}; override;
  function GetSecKind: TDeclSecKind; virtual;
  function IsVisible(LK: TDeclListKind): boolean; virtual;
  function GetTag: TDCURecTag;
end ;

TNameFDecl = class(TNameDecl)
  F: TNDX;
  Inf: integer;
  B2: TNDX; //D8+
  constructor Create(NoInf: boolean);
  procedure Show; override;
  function IsVisible(LK: TDeclListKind): boolean; override;
end ;

TTypeDecl = class(TNameFDecl)
  hDef: TDefNDX;
  constructor Create;
  function IsVisible(LK: TDeclListKind): boolean; override;
  procedure Show; override;
  function SetMem(MOfs,MSz: Cardinal): Cardinal {Rest}; override;
  function GetSecKind: TDeclSecKind; override;
end ;

TVarDecl = class(TNameFDecl)
  hDT: TDefNDX;
  Ofs: Cardinal;
  constructor Create;
  procedure Show; override;
  function GetSecKind: TDeclSecKind; override;
end ;

TVarCDecl = class(TVarDecl)
  Sz: Cardinal;
  OfsR: Cardinal;
  constructor Create(OfsValid: boolean);
  procedure Show; override;
  function SetMem(MOfs,MSz: Cardinal): Cardinal {Rest}; override;
  function GetSecKind: TDeclSecKind; override;
end ;

TAbsVarDecl = class(TVarDecl)
  procedure Show; override;
end ;

TTypePDecl = class(TVarCDecl{TTypeDecl})
  {B1: Byte;
  constructor Create;}
  constructor Create;
  procedure Show; override;
  function IsVisible(LK: TDeclListKind): boolean; override;
end ;

TThreadVarDecl = class(TVarDecl)
  function GetSecKind: TDeclSecKind; override;
end ;

//In Delphi>=8 they started to create this kind of records for string constants
TStrConstDecl = class({TVarCDecl}TNameFDecl)
  hDT: TDefNDX;
  Ofs: Cardinal;
  Sz: Cardinal;
  constructor Create;
  function SetMem(MOfs,MSz: Cardinal): Cardinal {Rest}; override;
  function GetSecKind: TDeclSecKind; override;
  procedure Show; override;
end ;



TLabelDecl = class(TNameDecl)
  Ofs: Cardinal;
  constructor Create;
  procedure Show; override;
  function GetSecKind: TDeclSecKind; override;
  function IsVisible(LK: TDeclListKind): boolean; override;
end ;

TExportDecl = class(TNameDecl)
  hSym,Index: TNDX;
  constructor Create;
  procedure Show; override;
  function GetSecKind: TDeclSecKind; override;
end ;

TLocalDecl = class(TNameDecl)
  LocFlags: TNDX;
  hDT: TDefNDX;
  NDXB: TNDX;//B: Byte; //Interface only
  Ndx: TNDX;
  constructor Create(LK: TDeclListKind);
  procedure Show; override;
  function GetLocFlagsSecKind: TDeclSecKind;
  function GetSecKind: TDeclSecKind; override;
end ;

TMethodDecl = class(TLocalDecl)
  InIntrf: boolean;
  hImport: TNDX; //for property P:X read Proc{virtual,Implemented in parent class}
  //VMTNDX: integer; //Offset in VMT of VM=VMTNDX*SizeOf(Pointer)
  constructor Create(LK: TDeclListKind);
  procedure Show; override;
end ;

TClassVarDecl = class(TLocalDecl)
  procedure Show; override;
  function GetSecKind: TDeclSecKind; override;
end ;

{TSetDeft struc pas
  sd: Cardinal;
ends
}

TPropDecl = class(TNameDecl)
  LocFlags: TNDX;
  hDT: TNDX;
  NDX: TNDX;
  hIndex: TNDX;
  hRead: TNDX;
  hWrite: TNDX;
  hStored: TNDX;
  hDeft: TNDX;
  constructor Create;
  procedure Show; override;
  function GetSecKind: TDeclSecKind; override;
end ;

TDispPropDecl = class(TLocalDecl)
  procedure Show; override;
end ;

TConstDeclBase = class(TNameFDecl)
  hDT: TDefNDX;
  hX: Cardinal; //Ver>4
  ValPtr: Pointer;
  ValSz: Cardinal;
  Val: integer;
  constructor Create;
  procedure ReadConstVal;
  procedure ShowValue;
  procedure Show; override;
  function GetSecKind: TDeclSecKind; override;
end ;

TConstDecl = class(TConstDeclBase)
  constructor Create;
end ;
{
TResStrDef = class(TConstDeclBase)
  NDX: TNDX;
  NDX1: TNDX;
  B1: Byte;
  B2: Byte;
  V: TNDX; //Data type again - AnsiString
  RefOfs,RefSz: Cardinal;
  constructor Create;
  procedure Show; override;
  procedure SetMem(MOfs,MSz: Cardinal); override;
end ;}

TResStrDef = class(TVarCDecl)
  OfsR: Cardinal;
  constructor Create;
  procedure Show; override;
  function GetSecKind: TDeclSecKind; override;
end ;

TSetDeftInfo=class(TNameDecl{TDCURec, but it should be included into NameDecl list})
  hConst,hArg: TDefNDX;
  constructor Create;
  procedure Show; override;
end ;

TCopyDecl = class(TNameDecl)
  hBase: TDefNDX;
  Base: TNameDecl; //Just in case and for convenience
  constructor Create;
  procedure Show; override;
  function GetSecKind: TDeclSecKind; override;
end ;

(*
TProcDeclBase = class(TNameDecl)
  CodeOfs,AddrBase: Cardinal;
  Sz: TDefNDX;
  constructor Create;
  function SetMem(MOfs,MSz: Cardinal): Cardinal {Rest}; override;
  function GetSecKind: TDeclSecKind; override;
end ;
*)

TProcCallKind = (pcRegister,pcCdecl,pcPascal,pcStdCall,pcSafeCall);

TMethodKind = (mkProc,mkMethod,mkConstructor,mkDestructor);

TProcDecl = class(TNameFDecl{TProcDeclBase})
  CodeOfs,AddrBase: Cardinal;
  Sz: TDefNDX;
 {---}
  B0: TNDX;
  VProc: TNDX;
  hDTRes: TNDX;
  Args: TNameDecl;
  Locals: TNameDecl;
  Embedded: TNameDecl;
  CallKind: TProcCallKind;
  MethodKind: TMethodKind; //may be this information is encoded by some flag, but
    //I can't detect it. May be it would be enough to analyse the structure of
    //the procedure name, but this way it will be safer.
  JustData: boolean; //This flag is turned on by Fixups from String typed consts
  FProcLocVarTbl: PLocVarTbl;
  FProcLocVarCnt: integer;
  constructor Create(AnEmbedded: TNameDecl; NoInf: boolean);
  destructor Destroy; override;
  function IsUnnamed: boolean;
  function SetMem(MOfs,MSz: Cardinal): Cardinal {Rest}; override;
  function GetSecKind: TDeclSecKind; override;
  procedure ShowArgs;
  function IsProc: boolean;
  procedure ShowDef(All: boolean); override;
  procedure Show; override;
  function IsVisible(LK: TDeclListKind): boolean; override;
  function GetRegDebugInfo(ProcOfs: integer; hReg: THBMName; Ofs: integer): String;
end ;

TSysProcDecl = class(TNameDecl{TProcDeclBase})
  F: TNDX;
  Ndx: TNDX;
//  CodeOfs: Cardinal;
  constructor Create;
  procedure Show; override;
  function GetSecKind: TDeclSecKind; override;
end ;

//Starting from Delphi 8 Borlands begin to give complete proc. defs to system
//procedures
TSysProc8Decl = class(TProcDecl)
  F: TNDX;
  Ndx: TNDX;
//  CodeOfs: Cardinal;
  constructor Create;
//  procedure Show; override;
end ;



(*
TAtDecl = class(TNameDecl)
  //May be start of implementation?
  NDX: TNDX;
  NDX1: TNDX;
  constructor Create;
  procedure Show; virtual;
end ;
*)

TUnitAddInfo = class(TNameFDecl)
 //Ver 8.0 and higher, MSIL
  B: TNDX;
  Sub: TNameDecl;
  constructor Create;
  destructor Destroy; override;
  function IsVisible(LK: TDeclListKind): boolean; override;
end ;

TSpecVar = class(TVarDecl)
  procedure Show; override;
end ;

(*
TAddInfo6 = class(TNameDecl)
  V0,V1,V2,V3: TNDX;
  Ofs: Cardinal;
  Sz: Cardinal;
  constructor Create;
  procedure Show; override;
  function SetMem(MOfs,MSz: Cardinal): Cardinal {Rest}; override;
end ;
*)
type

TTypeDef = class(TBaseDef)
//  hDecl: integer;
  RTTISz: TNDX; //Size of RTTI for type, if available
  Sz: TNDX; //Size of corresponding variable
  V: TNDX;
  RTTIOfs: Cardinal;
  constructor Create;
  destructor Destroy; override;
  procedure ShowBase;
  procedure Show; override;
  function SetMem(MOfs,MSz: Cardinal): Cardinal {Rest}; override;
  function ShowValue(DP: Pointer; DS: Cardinal): integer {Size used}; virtual;
  function GetOfsQualifier(Ofs: integer): String; virtual;
  function GetRefOfsQualifier(Ofs: integer): String; virtual;
end ;

TRangeBaseDef = class(TTypeDef)
  hDTBase: TNDX;
  LH: Pointer;
  {Lo: TNDX;
  Hi: TNDX;}
  B: Byte;
  procedure GetRange(var Lo,Hi: TInt64Rec);
  function ShowValue(DP: Pointer; DS: Cardinal): integer {Size used}; override;
  procedure Show; override;
end ;

TRangeDef = class(TRangeBaseDef)
  constructor Create;
end ;

TEnumDef = class(TRangeBaseDef)
  Ndx: TNDX;
  NameTbl: TList;
  constructor Create;
  destructor Destroy; override;
  function ShowValue(DP: Pointer; DS: Cardinal): integer {Size used}; override;
  procedure Show; override;
end ;

TFloatDef = class(TTypeDef)
  B: Byte;
  constructor Create;
  function ShowValue(DP: Pointer; DS: Cardinal): integer {Size used}; override;
  procedure Show; override;
end ;

TPtrDef = class(TTypeDef)
  hRefDT: TNDX;
  constructor Create;
  function ShowRefValue(Ndx: TNDX; Ofs: Cardinal): boolean;
  function ShowValue(DP: Pointer; DS: Cardinal): integer {Size used}; override;
  procedure Show; override;
  function GetRefOfsQualifier(Ofs: integer): String; override;
end ;

TTextDef = class(TTypeDef)
  procedure Show; override;
end ;

TFileDef = class(TTypeDef)
  hBaseDT: TNDX;
  constructor Create;
  procedure Show; override;
end ;

TSetDef = class(TTypeDef)
  BStart: Byte; //0-based start byte number
  hBaseDT: TNDX;
  constructor Create;
  function ShowValue(DP: Pointer; DS: Cardinal): integer {Size used}; override;
  procedure Show; override;
end ;

TArrayDef = class(TTypeDef)
  B1: Byte;
  hDTNdx: TNDX;
  hDTEl: TNDX;
  constructor Create(IsStr: boolean);
  function ShowValue(DP: Pointer; DS: Cardinal): integer {Size used}; override;
  procedure Show; override;
  function GetOfsQualifier(Ofs: integer): String; override;
end ;

TShortStrDef = class(TArrayDef)
  function ShowValue(DP: Pointer; DS: Cardinal): integer {Size used}; override;
  procedure Show; override;
end ;

TStringDef = class(TArrayDef)
  function ShowRefValue(Ndx: TNDX; Ofs: Cardinal): boolean;
  function ShowValue(DP: Pointer; DS: Cardinal): integer {Size used}; override;
  procedure Show; override;
end ;

TVariantDef = class(TTypeDef)
  B: byte;
  constructor Create;
  procedure Show; override;
end ;

TObjVMTDef = class(TTypeDef)
  hObjDT: TNDX;
  Ndx1: TNDX;
  constructor Create;
  procedure Show; override;
end ;

TRecBaseDef = class(TTypeDef)
  Fields: TNameDecl;
  procedure ReadFields(LK: TDeclListKind);
  function ShowFieldValues(DP: Pointer; DS: Cardinal): integer {Size used};
  destructor Destroy; override;
  function GetParentType: TNDX; virtual;
  function GetFldOfsQualifier(Ofs: integer; TotSize: integer; Sorted: boolean): String;
  function GetFldProperty(Fld: TNameDecl; hDT: TNDX): TPropDecl;
end ;

TRecDef = class(TRecBaseDef)
  B2: Byte;
  constructor Create;
  function ShowValue(DP: Pointer; DS: Cardinal): integer {Size used}; override;
  procedure Show; override;
  function GetOfsQualifier(Ofs: integer): String; override;
end ;

TProcTypeDef = class(TRecBaseDef)
  NDX0: TNDX;//B0: Byte; //Ver>2
  hDTRes: TNDX;
  AddStart: Pointer;
  AddSz: Cardinal; //Ver>2
  CallKind: TProcCallKind;
  constructor Create;
  function IsProc: boolean;
  function ShowValue(DP: Pointer; DS: Cardinal): integer {Size used}; override;
  function ProcStr: String;
  procedure ShowDecl(Braces: PChar);
  procedure Show; override;
end ;

TObjDef = class(TRecBaseDef)
  B03: Byte;
  hParent: TNDX;
  BFE: Byte;
  Ndx1: TNDX;
  B00: Byte;
  constructor Create;
  function ShowValue(DP: Pointer; DS: Cardinal): integer {Size used}; override;
  procedure Show; override;
  function GetParentType: TNDX; override;
  function GetOfsQualifier(Ofs: integer): String; override;
end ;

TClassDef = class(TRecBaseDef)
  hParent: TNDX;
//  InstBase: TTypeDef;