mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-18 10:59:44 +02:00
* ppudump: Work in progress on JSON output.
git-svn-id: trunk@24311 -
This commit is contained in:
yury
parent
307454e3a6
commit
61ac7580b7
@ -619,13 +619,13 @@ begin
|
||||
writeln;
|
||||
end;
|
||||
|
||||
procedure readdefinitions(const s:string); forward;
|
||||
procedure readdefinitions(const s:string; ParentDef: TPpuContainerDef); forward;
|
||||
procedure readsymbols(const s:string); forward;
|
||||
|
||||
procedure readsymtable(const s: string);
|
||||
procedure readsymtable(const s: string; ParentDef: TPpuContainerDef = nil);
|
||||
begin
|
||||
readsymtableoptions(s);
|
||||
readdefinitions(s);
|
||||
readdefinitions(s, ParentDef);
|
||||
readsymbols(s);
|
||||
end;
|
||||
|
||||
@ -704,14 +704,16 @@ end;
|
||||
Procedure ReadDerefmap;
|
||||
var
|
||||
i,mapsize : longint;
|
||||
s: string;
|
||||
begin
|
||||
mapsize:=ppufile.getlongint;
|
||||
writeln(['DerefMapsize: ',mapsize]);
|
||||
SetLength(CurUnit.RefUnits, mapsize);
|
||||
for i:=0 to mapsize-1 do
|
||||
begin
|
||||
CurUnit.RefUnits[i]:=ppufile.getstring;
|
||||
writeln(['DerefMap[',i,'] = ',CurUnit.RefUnits[i]]);
|
||||
s:=ppufile.getstring;
|
||||
writeln(['DerefMap[',i,'] = ',s]);
|
||||
CurUnit.RefUnits[i]:=LowerCase(s);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -858,7 +860,7 @@ begin
|
||||
getexprint.svalue:=ppufile.getint64;
|
||||
end;
|
||||
|
||||
Procedure ReadPosInfo;
|
||||
Procedure ReadPosInfo(Def: TPpuDef = nil);
|
||||
var
|
||||
info : byte;
|
||||
fileindex,line,column : longint;
|
||||
@ -891,11 +893,17 @@ begin
|
||||
3 : column:=getlongint;
|
||||
end;
|
||||
Writeln([fileindex,' (',line,',',column,')']);
|
||||
if Def <> nil then
|
||||
begin
|
||||
Def.FilePos.FileIndex:=fileindex - 1;
|
||||
Def.FilePos.Line:=line;
|
||||
Def.FilePos.Col:=column;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure readderef(const derefspace: string);
|
||||
procedure readderef(const derefspace: string; Ref: TPpuRef = nil);
|
||||
var
|
||||
b : tdereftype;
|
||||
first : boolean;
|
||||
@ -945,12 +953,16 @@ begin
|
||||
idx:=pdata[i] shl 24 or pdata[i+1] shl 16 or pdata[i+2] shl 8 or pdata[i+3];
|
||||
inc(i,4);
|
||||
write(['DefId ',idx]);
|
||||
if Ref <> nil then
|
||||
Ref.Id:=idx;
|
||||
end;
|
||||
deref_unit :
|
||||
begin
|
||||
idx:=pdata[i] shl 8 or pdata[i+1];
|
||||
inc(i,2);
|
||||
write(['Unit ',idx]);
|
||||
if Ref <> nil then
|
||||
Ref.UnitIndex:=idx;
|
||||
end;
|
||||
else
|
||||
begin
|
||||
@ -1220,7 +1232,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure readcommonsym(const s:string);
|
||||
procedure readcommonsym(const s:string; Def: TPpuDef = nil);
|
||||
begin
|
||||
writeln([space,'** Symbol Id ',ppufile.getlongint,' **']);
|
||||
writeln([space,s,ppufile.getstring]);
|
||||
@ -1238,7 +1250,7 @@ var
|
||||
current_defoptions : tdefoptions;
|
||||
current_objectoptions : tobjectoptions;
|
||||
|
||||
procedure readcommondef(const s:string; out defoptions: tdefoptions);
|
||||
procedure readcommondef(const s:string; out defoptions: tdefoptions; Def: TPpuDef = nil);
|
||||
type
|
||||
tdefopt=record
|
||||
mask : tdefoption;
|
||||
@ -1359,7 +1371,10 @@ var
|
||||
end;
|
||||
|
||||
begin
|
||||
writeln([space,'** Definition Id ',ppufile.getlongint,' **']);
|
||||
i:=ppufile.getlongint;
|
||||
if Def <> nil then
|
||||
Def.Id:=i;
|
||||
writeln([space,'** Definition Id ',i,' **']);
|
||||
writeln([space,s]);
|
||||
write ([space,' Type symbol : ']);
|
||||
readderef('');
|
||||
@ -1530,7 +1545,7 @@ end;
|
||||
{ type tproctypeoption is in globtype unit }
|
||||
{ type tprocoption is in globtype unit }
|
||||
|
||||
procedure read_abstract_proc_def(var proccalloption:tproccalloption;var procoptions:tprocoptions);
|
||||
procedure read_abstract_proc_def(var proccalloption:tproccalloption;var procoptions:tprocoptions; ProcDef: TPpuProcDef);
|
||||
type
|
||||
tproccallopt=record
|
||||
mask : tproccalloption;
|
||||
@ -1619,7 +1634,7 @@ var
|
||||
tempbuf : array[0..255] of byte;
|
||||
begin
|
||||
write([space,' Return type : ']);
|
||||
readderef('');
|
||||
readderef('', ProcDef.ReturnType);
|
||||
writeln([space,' Fpu used : ',ppufile.getbyte]);
|
||||
proctypeoption:=tproctypeoption(ppufile.getbyte);
|
||||
write([space,' TypeOption : ']);
|
||||
@ -2335,7 +2350,7 @@ end;
|
||||
Read defintions Part
|
||||
****************************************************************************}
|
||||
|
||||
procedure readdefinitions(const s:string);
|
||||
procedure readdefinitions(const s:string; ParentDef: TPpuContainerDef);
|
||||
{ type tordtype is in symconst unit }
|
||||
{
|
||||
uvoid,
|
||||
@ -2353,6 +2368,8 @@ var
|
||||
calloption : tproccalloption;
|
||||
procoptions : tprocoptions;
|
||||
defoptions: tdefoptions;
|
||||
procdef: TPpuProcDef;
|
||||
ptypedef: TPpuProcTypeDef;
|
||||
begin
|
||||
with ppufile do
|
||||
begin
|
||||
@ -2421,8 +2438,9 @@ begin
|
||||
|
||||
ibprocdef :
|
||||
begin
|
||||
readcommondef('Procedure definition',defoptions);
|
||||
read_abstract_proc_def(calloption,procoptions);
|
||||
procdef:=TPpuProcDef.Create(ParentDef);
|
||||
readcommondef('Procedure definition',defoptions,procdef);
|
||||
read_abstract_proc_def(calloption,procoptions,procdef);
|
||||
if (po_has_mangledname in procoptions) then
|
||||
{$ifdef symansistr}
|
||||
writeln([space,' Mangled name : ',getansistring]);
|
||||
@ -2436,7 +2454,7 @@ begin
|
||||
write ([space,' Procsym : ']);
|
||||
readderef('');
|
||||
write ([space,' File Pos : ']);
|
||||
readposinfo;
|
||||
readposinfo(procdef);
|
||||
writeln([space,' Visibility : ',Visibility2Str(ppufile.getbyte)]);
|
||||
write ([space,' SymOptions : ']);
|
||||
readsymoptions(space+' ');
|
||||
@ -2492,8 +2510,9 @@ begin
|
||||
|
||||
ibprocvardef :
|
||||
begin
|
||||
readcommondef('Procedural type (ProcVar) definition',defoptions);
|
||||
read_abstract_proc_def(calloption,procoptions);
|
||||
ptypedef:=TPpuProcTypeDef.Create(ParentDef);
|
||||
readcommondef('Procedural type (ProcVar) definition',defoptions,ptypedef);
|
||||
read_abstract_proc_def(calloption,procoptions, ptypedef);
|
||||
writeln([space,' Symtable level :',ppufile.getbyte]);
|
||||
if not EndOfEntry then
|
||||
HasMoreInfos;
|
||||
@ -3053,7 +3072,7 @@ begin
|
||||
Writeln;
|
||||
Writeln('Interface definitions');
|
||||
Writeln('----------------------');
|
||||
readdefinitions('interface');
|
||||
readdefinitions('interface', CurUnit);
|
||||
end
|
||||
else
|
||||
ppufile.skipuntilentry(ibenddefs);
|
||||
@ -3116,7 +3135,7 @@ begin
|
||||
Writeln;
|
||||
Writeln('Static definitions');
|
||||
Writeln('----------------------');
|
||||
readdefinitions('implementation');
|
||||
readdefinitions('implementation', nil);
|
||||
end
|
||||
else
|
||||
ppufile.skipuntilentry(ibenddefs);
|
||||
@ -3236,6 +3255,7 @@ begin
|
||||
|
||||
UnitList:=TPpuContainerDef.Create(nil);
|
||||
try
|
||||
UnitList.ItemsName:='';
|
||||
{ process files }
|
||||
for nrfile:=startpara to paramcount do
|
||||
dofile (paramstr(nrfile));
|
||||
|
||||
@ -37,16 +37,15 @@ type
|
||||
procedure BeforeWriteElement;
|
||||
procedure WriteAttr(const AName, AValue: string);
|
||||
protected
|
||||
procedure WriteDefStart(Def: TPpuDef); override;
|
||||
procedure WriteDefEnd(Def: TPpuDef); override;
|
||||
procedure WriteSubItemsStart(Def: TPpuContainerDef); override;
|
||||
procedure WriteSubItemsEnd(Def: TPpuContainerDef); override;
|
||||
procedure WriteObjectStart(const AName: string; Def: TPpuDef); override;
|
||||
procedure WriteObjectEnd(Def: TPpuDef); override;
|
||||
procedure WriteArrayStart(const AName: string); override;
|
||||
procedure WriteArrayEnd(const AName: string); override;
|
||||
procedure WriteArrayEnd; override;
|
||||
procedure WriteStr(const AName, AValue: string); override;
|
||||
procedure WriteInt(const AName: string; AValue: Int64); override;
|
||||
procedure WriteFloat(const AName: string; AValue: extended); override;
|
||||
procedure WriteBool(const AName: string; AValue: boolean); override;
|
||||
procedure WriteNull(const AName: string); override;
|
||||
public
|
||||
constructor Create(var OutFile: Text); override;
|
||||
procedure IncI; override;
|
||||
@ -155,53 +154,6 @@ begin
|
||||
Write(AValue);
|
||||
end;
|
||||
|
||||
procedure TPpuJsonOutput.WriteDefStart(Def: TPpuDef);
|
||||
begin
|
||||
if Def.Parent = nil then
|
||||
// Top level container
|
||||
exit;
|
||||
WriteLn('{');
|
||||
IncI;
|
||||
if Def.DefType <> dtNone then
|
||||
WriteStr('Type', Def.DefTypeName);
|
||||
if Def.Name <> '' then
|
||||
WriteStr('Name', Def.Name);
|
||||
end;
|
||||
|
||||
procedure TPpuJsonOutput.WriteDefEnd(Def: TPpuDef);
|
||||
var
|
||||
s: string;
|
||||
begin
|
||||
if Def.Parent = nil then
|
||||
// Top level container
|
||||
exit;
|
||||
DecI;
|
||||
s:='}';
|
||||
// Last def in list?
|
||||
if (Def.Parent <> nil) and (Def.Parent[Def.Parent.Count - 1] <> Def) then
|
||||
s:=s + ',';
|
||||
WriteLn(s);
|
||||
end;
|
||||
|
||||
procedure TPpuJsonOutput.WriteSubItemsStart(Def: TPpuContainerDef);
|
||||
begin
|
||||
if Def.Parent = nil then begin
|
||||
// Top level container
|
||||
WriteLn('[');
|
||||
exit;
|
||||
end;
|
||||
BeforeWriteElement;
|
||||
WriteLn(Format('"%s": [', [Def.ItemsName]));
|
||||
end;
|
||||
|
||||
procedure TPpuJsonOutput.WriteSubItemsEnd(Def: TPpuContainerDef);
|
||||
begin
|
||||
Write(']');
|
||||
if Def.Parent = nil then
|
||||
// Top level container
|
||||
WriteLn;
|
||||
end;
|
||||
|
||||
procedure TPpuJsonOutput.WriteStr(const AName, AValue: string);
|
||||
begin
|
||||
WriteAttr(AName, JsonStr(AValue));
|
||||
@ -228,19 +180,37 @@ begin
|
||||
WriteAttr(AName, 'false');
|
||||
end;
|
||||
|
||||
procedure TPpuJsonOutput.WriteArrayStart(const AName: string);
|
||||
procedure TPpuJsonOutput.WriteNull(const AName: string);
|
||||
begin
|
||||
BeforeWriteElement;
|
||||
WriteLn(Format('"%s": [', [AName]));
|
||||
IncI;
|
||||
WriteAttr(AName, 'null');
|
||||
end;
|
||||
|
||||
procedure TPpuJsonOutput.WriteArrayEnd(const AName: string);
|
||||
procedure TPpuJsonOutput.WriteArrayStart(const AName: string);
|
||||
begin
|
||||
DecI;
|
||||
WriteAttr(AName, '[');
|
||||
WriteLn;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TPpuJsonOutput.WriteArrayEnd;
|
||||
begin
|
||||
inherited;
|
||||
Write(']');
|
||||
end;
|
||||
|
||||
procedure TPpuJsonOutput.WriteObjectStart(const AName: string; Def: TPpuDef);
|
||||
begin
|
||||
WriteAttr(AName, '{');
|
||||
WriteLn;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TPpuJsonOutput.WriteObjectEnd(Def: TPpuDef);
|
||||
begin
|
||||
inherited;
|
||||
Write('}');
|
||||
end;
|
||||
|
||||
constructor TPpuJsonOutput.Create(var OutFile: Text);
|
||||
begin
|
||||
inherited Create(OutFile);
|
||||
|
||||
@ -21,20 +21,21 @@
|
||||
|
||||
unit ppuout;
|
||||
{$mode objfpc}{$H+}
|
||||
{$I+}
|
||||
|
||||
interface
|
||||
|
||||
uses SysUtils, Classes;
|
||||
uses SysUtils, cclasses, Classes;
|
||||
|
||||
type
|
||||
TPpuDefType = (dtNone, dtUnit, dtClass, dtRecord, dtProc, dtField, dtProp, dtParam, dtVar,
|
||||
TPpuDefType = (dtNone, dtUnit, dtObject, dtRecord, dtProc, dtField, dtProp, dtParam, dtVar,
|
||||
dtType, dtConst, dtProcType, dtEnum, dtSet);
|
||||
|
||||
TPpuDef = class;
|
||||
TPpuContainerDef = class;
|
||||
TPpuUnitDef = class;
|
||||
|
||||
{ TPpuOutput }
|
||||
|
||||
TPpuOutput = class
|
||||
private
|
||||
FOutFile: ^Text;
|
||||
@ -45,16 +46,15 @@ type
|
||||
procedure SetIndent(AValue: integer);
|
||||
procedure SetIndentSize(AValue: integer);
|
||||
protected
|
||||
procedure WriteDefStart(Def: TPpuDef); virtual;
|
||||
procedure WriteDefEnd(Def: TPpuDef); virtual;
|
||||
procedure WriteSubItemsStart(Def: TPpuContainerDef); virtual;
|
||||
procedure WriteSubItemsEnd(Def: TPpuContainerDef); virtual;
|
||||
procedure WriteObjectStart(const AName: string; Def: TPpuDef = nil); virtual;
|
||||
procedure WriteObjectEnd(Def: TPpuDef = nil); virtual;
|
||||
procedure WriteArrayStart(const AName: string); virtual;
|
||||
procedure WriteArrayEnd; virtual;
|
||||
procedure WriteStr(const AName, AValue: string); virtual;
|
||||
procedure WriteInt(const AName: string; AValue: Int64); virtual;
|
||||
procedure WriteFloat(const AName: string; AValue: extended); virtual;
|
||||
procedure WriteBool(const AName: string; AValue: boolean); virtual;
|
||||
procedure WriteArrayStart(const AName: string); virtual;
|
||||
procedure WriteArrayEnd(const AName: string); virtual;
|
||||
procedure WriteNull(const AName: string); virtual;
|
||||
public
|
||||
constructor Create(var OutFile: Text); virtual;
|
||||
destructor Destroy; override;
|
||||
@ -66,13 +66,30 @@ type
|
||||
property IndentSize: integer read FIndentSize write SetIndentSize;
|
||||
end;
|
||||
|
||||
{ TPpuRef }
|
||||
TPpuRef = class
|
||||
public
|
||||
UnitIndex: word;
|
||||
Id: integer;
|
||||
constructor Create;
|
||||
procedure Write(Output: TPpuOutput; const RefName: string);
|
||||
end;
|
||||
|
||||
TPpuFilePos = record
|
||||
FileIndex: dword;
|
||||
Line, Col: integer;
|
||||
end;
|
||||
|
||||
{ TPpuDef }
|
||||
|
||||
TPpuDef = class
|
||||
private
|
||||
FId: integer;
|
||||
FParent: TPpuContainerDef;
|
||||
FParentUnit: TPpuUnitDef;
|
||||
function GetDefTypeName: string;
|
||||
procedure SetProps(AValue: TStringList);
|
||||
function GetParentUnit: TPpuUnitDef;
|
||||
procedure SetId(AValue: integer);
|
||||
|
||||
protected
|
||||
procedure WriteDef(Output: TPpuOutput); virtual;
|
||||
@ -80,17 +97,18 @@ type
|
||||
public
|
||||
DefType: TPpuDefType;
|
||||
Name: string;
|
||||
DefId: integer;
|
||||
FilePos: TPpuFilePos;
|
||||
|
||||
constructor Create(AParent: TPpuContainerDef); virtual; reintroduce;
|
||||
destructor Destroy; override;
|
||||
procedure Write(Output: TPpuOutput);
|
||||
property Parent: TPpuContainerDef read FParent;
|
||||
property ParentUnit: TPpuUnitDef read GetParentUnit;
|
||||
property Id: integer read FId write SetId;
|
||||
property DefTypeName: string read GetDefTypeName;
|
||||
end;
|
||||
|
||||
{ TPpuContainerDef }
|
||||
|
||||
TPpuContainerDef = class(TPpuDef)
|
||||
private
|
||||
FItems: TList;
|
||||
@ -112,8 +130,9 @@ type
|
||||
end;
|
||||
|
||||
{ TPpuUnitDef }
|
||||
|
||||
TPpuUnitDef = class(TPpuContainerDef)
|
||||
private
|
||||
FIndexById: THashSet;
|
||||
protected
|
||||
procedure WriteDef(Output: TPpuOutput); override;
|
||||
public
|
||||
@ -123,12 +142,13 @@ type
|
||||
UsedUnits: TPpuContainerDef;
|
||||
RefUnits: array of string;
|
||||
SourceFiles: TPpuContainerDef;
|
||||
|
||||
constructor Create(AParent: TPpuContainerDef); override;
|
||||
destructor Destroy; override;
|
||||
function FindById(AId: integer): TPpuDef;
|
||||
end;
|
||||
|
||||
{ TPpuSrcFile }
|
||||
|
||||
TPpuSrcFile = class(TPpuDef)
|
||||
protected
|
||||
procedure WriteDef(Output: TPpuOutput); override;
|
||||
@ -136,13 +156,80 @@ type
|
||||
FileTime: TDateTime;
|
||||
end;
|
||||
|
||||
{ TPpuProcDef }
|
||||
TPpuProcDef = class(TPpuContainerDef)
|
||||
protected
|
||||
procedure WriteDef(Output: TPpuOutput); override;
|
||||
public
|
||||
ReturnType: TPpuRef;
|
||||
constructor Create(AParent: TPpuContainerDef); override;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
{ TPpuProcTypeDef }
|
||||
TPpuProcTypeDef = class(TPpuProcDef)
|
||||
public
|
||||
constructor Create(AParent: TPpuContainerDef); override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
const
|
||||
DefTypeNames: array[TPpuDefType] of string =
|
||||
('', 'unit', 'class', 'record', 'procedure', 'field', 'property', 'parameter', 'variable',
|
||||
('', 'unit', 'object', 'record', 'procedure', 'field', 'property', 'parameter', 'variable',
|
||||
'type', 'constant', 'proctype', 'enum', 'set');
|
||||
|
||||
{ TPpuRef }
|
||||
|
||||
constructor TPpuRef.Create;
|
||||
begin
|
||||
UnitIndex:=$FFFF;
|
||||
Id:=-1;
|
||||
end;
|
||||
|
||||
procedure TPpuRef.Write(Output: TPpuOutput; const RefName: string);
|
||||
begin
|
||||
with Output do
|
||||
if Id < 0 then
|
||||
WriteNull(RefName)
|
||||
else begin
|
||||
WriteObjectStart(RefName);
|
||||
if UnitIndex <> $FFFF then
|
||||
WriteInt('RefUnit', UnitIndex);
|
||||
WriteInt('Id', Id);
|
||||
WriteObjectEnd;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TPpuProcTypeDef }
|
||||
|
||||
constructor TPpuProcTypeDef.Create(AParent: TPpuContainerDef);
|
||||
begin
|
||||
inherited Create(AParent);
|
||||
DefType:=dtProcType;
|
||||
end;
|
||||
|
||||
{ TPpuProcDef }
|
||||
|
||||
procedure TPpuProcDef.WriteDef(Output: TPpuOutput);
|
||||
begin
|
||||
inherited WriteDef(Output);
|
||||
ReturnType.Write(Output, 'ReturnType');
|
||||
end;
|
||||
|
||||
constructor TPpuProcDef.Create(AParent: TPpuContainerDef);
|
||||
begin
|
||||
inherited Create(AParent);
|
||||
DefType:=dtProc;
|
||||
ReturnType:=TPpuRef.Create;
|
||||
end;
|
||||
|
||||
destructor TPpuProcDef.Destroy;
|
||||
begin
|
||||
ReturnType.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
{ TPpuSrcFile }
|
||||
|
||||
procedure TPpuSrcFile.WriteDef(Output: TPpuOutput);
|
||||
@ -170,22 +257,6 @@ begin
|
||||
FIndentSize:=AValue;
|
||||
end;
|
||||
|
||||
procedure TPpuOutput.WriteDefStart(Def: TPpuDef);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TPpuOutput.WriteDefEnd(Def: TPpuDef);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TPpuOutput.WriteSubItemsStart(Def: TPpuContainerDef);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TPpuOutput.WriteSubItemsEnd(Def: TPpuContainerDef);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TPpuOutput.WriteStr(const AName, AValue: string);
|
||||
begin
|
||||
end;
|
||||
@ -204,22 +275,42 @@ begin
|
||||
end;
|
||||
|
||||
procedure TPpuOutput.WriteBool(const AName: string; AValue: boolean);
|
||||
var
|
||||
s: string;
|
||||
begin
|
||||
if AValue then
|
||||
s:='1'
|
||||
WriteStr(AName, '1')
|
||||
else
|
||||
s:='0';
|
||||
WriteStr(AName, s);
|
||||
WriteStr(AName, '0');
|
||||
end;
|
||||
|
||||
procedure TPpuOutput.WriteNull(const AName: string);
|
||||
begin
|
||||
WriteStr(AName, '');
|
||||
end;
|
||||
|
||||
procedure TPpuOutput.WriteArrayStart(const AName: string);
|
||||
begin
|
||||
IncI;
|
||||
end;
|
||||
|
||||
procedure TPpuOutput.WriteArrayEnd(const AName: string);
|
||||
procedure TPpuOutput.WriteArrayEnd;
|
||||
begin
|
||||
DecI;
|
||||
end;
|
||||
|
||||
procedure TPpuOutput.WriteObjectStart(const AName: string; Def: TPpuDef);
|
||||
begin
|
||||
IncI;
|
||||
if Def = nil then
|
||||
exit;
|
||||
if Def.DefType <> dtNone then
|
||||
WriteStr('Type', Def.DefTypeName);
|
||||
if Def.Name <> '' then
|
||||
WriteStr('Name', Def.Name);
|
||||
end;
|
||||
|
||||
procedure TPpuOutput.WriteObjectEnd(Def: TPpuDef);
|
||||
begin
|
||||
DecI;
|
||||
end;
|
||||
|
||||
constructor TPpuOutput.Create(var OutFile: Text);
|
||||
@ -271,15 +362,15 @@ begin
|
||||
if TargetOS <> '' then
|
||||
WriteStr('TargetOS', TargetOS);
|
||||
if Crc <> 0 then
|
||||
WriteStr('Crc', hexStr(Crc, 8));
|
||||
WriteStr('CRC', hexStr(Crc, 8));
|
||||
if IntfCrc <> 0 then
|
||||
WriteStr('InterfaceCrc', hexStr(IntfCrc, 8));
|
||||
WriteStr('InterfaceCRC', hexStr(IntfCrc, 8));
|
||||
UsedUnits.WriteDef(Output);
|
||||
if Length(RefUnits) > 0 then begin
|
||||
WriteArrayStart('RefUnits');
|
||||
for i:=0 to High(RefUnits) do
|
||||
WriteStr('', RefUnits[i]);
|
||||
WriteArrayEnd('RefUnits');
|
||||
WriteArrayEnd;
|
||||
end;
|
||||
SourceFiles.WriteDef(Output);
|
||||
end;
|
||||
@ -290,21 +381,36 @@ constructor TPpuUnitDef.Create(AParent: TPpuContainerDef);
|
||||
begin
|
||||
inherited Create(AParent);
|
||||
DefType:=dtUnit;
|
||||
ItemsName:='Interface';
|
||||
UsedUnits:=TPpuContainerDef.Create(nil);
|
||||
UsedUnits.FParent:=Self;
|
||||
UsedUnits.ItemsName:='UsedUnits';
|
||||
SourceFiles:=TPpuContainerDef.Create(nil);
|
||||
SourceFiles.FParent:=Self;
|
||||
SourceFiles.ItemsName:='SrcFiles';
|
||||
FIndexById:=THashSet.Create(64, True, False);
|
||||
end;
|
||||
|
||||
destructor TPpuUnitDef.Destroy;
|
||||
begin
|
||||
UsedUnits.Free;
|
||||
SourceFiles.Free;
|
||||
FIndexById.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TPpuUnitDef.FindById(AId: integer): TPpuDef;
|
||||
var
|
||||
h: PHashSetItem;
|
||||
begin
|
||||
h:=FIndexById.Find(@AId, SizeOf(AId));
|
||||
if h <> nil then
|
||||
Result:=TPpuDef(h^.Data)
|
||||
else
|
||||
Result:=nil;
|
||||
end;
|
||||
|
||||
|
||||
{ TPpuContainerDef }
|
||||
|
||||
function TPpuContainerDef.GetCount: integer;
|
||||
@ -329,14 +435,10 @@ begin
|
||||
inherited WriteDef(Output);
|
||||
if Count = 0 then
|
||||
exit;
|
||||
Output.WriteSubItemsStart(Self);
|
||||
if Parent <> nil then
|
||||
Output.IncI;
|
||||
Output.WriteArrayStart(ItemsName);
|
||||
for i:=0 to Count - 1 do
|
||||
Items[i].Write(Output);
|
||||
if Parent <> nil then
|
||||
Output.DecI;
|
||||
Output.WriteSubItemsEnd(Self);
|
||||
Output.WriteArrayEnd;
|
||||
end;
|
||||
|
||||
constructor TPpuContainerDef.Create(AParent: TPpuContainerDef);
|
||||
@ -369,22 +471,56 @@ begin
|
||||
Result:=DefTypeNames[DefType];
|
||||
end;
|
||||
|
||||
procedure TPpuDef.SetProps(AValue: TStringList);
|
||||
function TPpuDef.GetParentUnit: TPpuUnitDef;
|
||||
var
|
||||
d: TPpuContainerDef;
|
||||
begin
|
||||
if FParentUnit = nil then begin
|
||||
d:=Parent;
|
||||
while (d <> nil) and (d.DefType <> dtUnit) do
|
||||
d:=d.Parent;
|
||||
FParentUnit:=TPpuUnitDef(d);
|
||||
end;
|
||||
Result:=FParentUnit;
|
||||
end;
|
||||
|
||||
procedure TPpuDef.SetId(AValue: integer);
|
||||
var
|
||||
h: PHashSetItem;
|
||||
u: TPpuUnitDef;
|
||||
begin
|
||||
if FId = AValue then Exit;
|
||||
u:=ParentUnit;
|
||||
if (FId <> -1) and (u <> nil) then begin
|
||||
h:=u.FIndexById.Find(@FId, SizeOf(FId));
|
||||
if h <> nil then
|
||||
u.FIndexById.Remove(h);
|
||||
end;
|
||||
FId:=AValue;
|
||||
if (FId <> -1) and (u <> nil) then begin;
|
||||
h:=u.FIndexById.FindOrAdd(@FId, SizeOf(FId));
|
||||
h^.Data:=Self;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPpuDef.WriteDef(Output: TPpuOutput);
|
||||
begin
|
||||
with Output do begin
|
||||
if DefId >= 0 then
|
||||
WriteInt('Id', DefId);
|
||||
if Id >= 0 then
|
||||
WriteInt('Id', Id);
|
||||
if FilePos.Line > 0 then begin
|
||||
WriteObjectStart('SrcPos');
|
||||
WriteInt('SrcFile', FilePos.FileIndex);
|
||||
WriteInt('Line', FilePos.Line);
|
||||
WriteInt('Col', FilePos.Col);
|
||||
WriteObjectEnd;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TPpuDef.Create(AParent: TPpuContainerDef);
|
||||
begin
|
||||
DefId:=-1;
|
||||
FId:=-1;
|
||||
if AParent <> nil then
|
||||
AParent.Add(Self);
|
||||
end;
|
||||
@ -396,9 +532,11 @@ end;
|
||||
|
||||
procedure TPpuDef.Write(Output: TPpuOutput);
|
||||
begin
|
||||
Output.WriteDefStart(Self);
|
||||
if Parent <> nil then
|
||||
Output.WriteObjectStart('', Self);
|
||||
WriteDef(Output);
|
||||
Output.WriteDefEnd(Self);
|
||||
if Parent <> nil then
|
||||
Output.WriteObjectEnd(Self);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user