mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-04 02:39:40 +01:00
* ppudump: Started implementation of JSON output. Output of unit header info has been implemented.
git-svn-id: trunk@24299 -
This commit is contained in:
yury
parent
6327854259
commit
85c2d144c5
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -691,6 +691,8 @@ compiler/utils/msg2inc.pp svneol=native#text/plain
|
||||
compiler/utils/msgdif.pp svneol=native#text/plain
|
||||
compiler/utils/msgused.pl svneol=native#text/plain
|
||||
compiler/utils/ppudump/ppudump.pp svneol=native#text/plain
|
||||
compiler/utils/ppudump/ppujson.pp svneol=native#text/plain
|
||||
compiler/utils/ppudump/ppuout.pp svneol=native#text/plain
|
||||
compiler/utils/ppufiles.pp svneol=native#text/plain
|
||||
compiler/utils/ppumove.pp svneol=native#text/plain
|
||||
compiler/utils/samplecfg svneol=native#text/plain
|
||||
|
||||
@ -35,7 +35,9 @@ uses
|
||||
globals,
|
||||
globtype,
|
||||
widestr,
|
||||
tokens;
|
||||
tokens,
|
||||
ppuout,
|
||||
ppujson;
|
||||
|
||||
const
|
||||
Version = 'Version 2.7.1';
|
||||
@ -185,6 +187,10 @@ var
|
||||
verbose : longint;
|
||||
derefdata : pbyte;
|
||||
derefdatalen : longint;
|
||||
pout: TPpuOutput;
|
||||
nostdout: boolean;
|
||||
UnitList: TPpuContainerDef;
|
||||
CurUnit: TPpuUnitDef;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
@ -277,6 +283,7 @@ const has_errors : boolean = false;
|
||||
|
||||
procedure Write(const s: string);
|
||||
begin
|
||||
if nostdout then exit;
|
||||
system.write(s);
|
||||
end;
|
||||
|
||||
@ -284,6 +291,7 @@ procedure Write(const params: array of const);
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
if nostdout then exit;
|
||||
for i:=Low(params) to High(params) do
|
||||
with TVarRec(params[i]) do
|
||||
case VType of
|
||||
@ -305,11 +313,13 @@ end;
|
||||
|
||||
procedure Writeln(const s: string = '');
|
||||
begin
|
||||
if nostdout then exit;
|
||||
system.writeln(s);
|
||||
end;
|
||||
|
||||
procedure Writeln(const params: array of const);
|
||||
begin
|
||||
if nostdout then exit;
|
||||
Write(params);
|
||||
system.writeln;
|
||||
end;
|
||||
@ -674,14 +684,19 @@ end;
|
||||
procedure ReadLoadUnit;
|
||||
var
|
||||
ucrc,uintfcrc, indcrc : cardinal;
|
||||
un: TPpuUnitDef;
|
||||
begin
|
||||
while not ppufile.EndOfEntry do
|
||||
begin
|
||||
write(['Uses unit: ',ppufile.getstring]);
|
||||
un:=TPpuUnitDef.Create(CurUnit.UsedUnits);
|
||||
un.Name:=ppufile.getstring;
|
||||
write(['Uses unit: ',un.Name]);
|
||||
ucrc:=cardinal(ppufile.getlongint);
|
||||
uintfcrc:=cardinal(ppufile.getlongint);
|
||||
indcrc:=cardinal(ppufile.getlongint);
|
||||
writeln([' (Crc: ',hexstr(ucrc,8),', IntfcCrc: ',hexstr(uintfcrc,8),', IndCrc: ',hexstr(indcrc,8),')']);
|
||||
un.Crc:=ucrc;
|
||||
un.IntfCrc:=uintfcrc;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -692,8 +707,12 @@ var
|
||||
begin
|
||||
mapsize:=ppufile.getlongint;
|
||||
writeln(['DerefMapsize: ',mapsize]);
|
||||
SetLength(CurUnit.RefUnits, mapsize);
|
||||
for i:=0 to mapsize-1 do
|
||||
writeln(['DerefMap[',i,'] = ',ppufile.getstring]);
|
||||
begin
|
||||
CurUnit.RefUnits[i]:=ppufile.getstring;
|
||||
writeln(['DerefMap[',i,'] = ',CurUnit.RefUnits[i]]);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -2797,7 +2816,7 @@ end;
|
||||
procedure readinterface;
|
||||
var
|
||||
b : byte;
|
||||
sourcenumber : longint;
|
||||
sourcenumber, i : longint;
|
||||
begin
|
||||
with ppufile do
|
||||
begin
|
||||
@ -2806,7 +2825,10 @@ begin
|
||||
case b of
|
||||
|
||||
ibmodulename :
|
||||
Writeln(['Module Name: ',getstring]);
|
||||
begin
|
||||
CurUnit.Name:=getstring;
|
||||
Writeln(['Module Name: ',CurUnit.Name]);
|
||||
end;
|
||||
|
||||
ibmoduleoptions:
|
||||
readmoduleoptions(' ');
|
||||
@ -2816,7 +2838,14 @@ begin
|
||||
sourcenumber:=1;
|
||||
while not EndOfEntry do
|
||||
begin
|
||||
Writeln(['Source file ',sourcenumber,' : ',getstring,' ',filetimestring(getlongint)]);
|
||||
with TPpuSrcFile.Create(CurUnit.SourceFiles) do begin
|
||||
Name:=getstring;
|
||||
i:=getlongint;
|
||||
if i >= 0 then
|
||||
FileTime:=FileDateToDateTime(i);
|
||||
Writeln(['Source file ',sourcenumber,' : ',Name,' ',filetimestring(i)]);
|
||||
end;
|
||||
|
||||
inc(sourcenumber);
|
||||
end;
|
||||
end;
|
||||
@ -2969,6 +2998,10 @@ begin
|
||||
SetHasErrors;
|
||||
exit;
|
||||
end;
|
||||
|
||||
CurUnit:=TPpuUnitDef.Create(UnitList);
|
||||
CurUnit.Version:=ppuversion;
|
||||
|
||||
{ Write PPU Header Information }
|
||||
if (verbose and v_header)<>0 then
|
||||
begin
|
||||
@ -2991,6 +3024,15 @@ begin
|
||||
Writeln(['Symbols stored : ',tostr(symlistsize)]);
|
||||
end;
|
||||
end;
|
||||
|
||||
with ppufile.header do
|
||||
begin
|
||||
CurUnit.Crc:=checksum;
|
||||
CurUnit.IntfCrc:=interface_checksum;
|
||||
CurUnit.TargetCPU:=Cpu2Str(cpu);
|
||||
CurUnit.TargetOS:=Target2Str(target);
|
||||
end;
|
||||
|
||||
{read the general stuff}
|
||||
if (verbose and v_interface)<>0 then
|
||||
begin
|
||||
@ -3097,13 +3139,20 @@ begin
|
||||
Writeln;
|
||||
end;
|
||||
|
||||
|
||||
procedure WriteLogo;
|
||||
begin
|
||||
writeln(Title+' '+Version);
|
||||
writeln(Copyright);
|
||||
writeln;
|
||||
end;
|
||||
|
||||
procedure help;
|
||||
begin
|
||||
WriteLogo;
|
||||
writeln('usage: ppudump [options] <filename1> <filename2>...');
|
||||
writeln;
|
||||
writeln('[options] can be:');
|
||||
writeln(' -J output in JSON format');
|
||||
writeln(' -M Exit with ExitCode=2 if more information is available');
|
||||
writeln(' -V<verbose> Set verbosity to <verbose>');
|
||||
writeln(' H - Show header info');
|
||||
@ -3124,11 +3173,9 @@ var
|
||||
const
|
||||
error_on_more : boolean = false;
|
||||
begin
|
||||
writeln(Title+' '+Version);
|
||||
writeln(Copyright);
|
||||
writeln;
|
||||
if paramcount<1 then
|
||||
begin
|
||||
WriteLogo;
|
||||
writeln('usage: dumpppu [options] <filename1> <filename2>...');
|
||||
halt(1);
|
||||
end;
|
||||
@ -3140,6 +3187,10 @@ begin
|
||||
begin
|
||||
para:=paramstr(startpara);
|
||||
case upcase(para[2]) of
|
||||
'J' : begin
|
||||
nostdout:=True;
|
||||
pout:=TPpuJsonOutput.Create(Output);
|
||||
end;
|
||||
'M' : error_on_more:=true;
|
||||
'V' : begin
|
||||
verbose:=0;
|
||||
@ -3158,9 +3209,21 @@ begin
|
||||
end;
|
||||
inc(startpara);
|
||||
end;
|
||||
{ process files }
|
||||
for nrfile:=startpara to paramcount do
|
||||
dofile (paramstr(nrfile));
|
||||
|
||||
if not nostdout then
|
||||
WriteLogo;
|
||||
|
||||
UnitList:=TPpuContainerDef.Create(nil);
|
||||
try
|
||||
{ process files }
|
||||
for nrfile:=startpara to paramcount do
|
||||
dofile (paramstr(nrfile));
|
||||
if not has_errors and (pout <> nil) then
|
||||
UnitList.Write(pout);
|
||||
finally
|
||||
UnitList.Free;
|
||||
pout.Free;
|
||||
end;
|
||||
if has_errors then
|
||||
Halt(1);
|
||||
if error_on_more and has_more_infos then
|
||||
|
||||
267
compiler/utils/ppudump/ppujson.pp
Normal file
267
compiler/utils/ppudump/ppujson.pp
Normal file
@ -0,0 +1,267 @@
|
||||
{
|
||||
Copyright (c) 2013 by Yury Sidorov and the FPC Development Team
|
||||
|
||||
JSON output of a PPU File
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation; either version 2 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program; if not, write to the Free Software
|
||||
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
||||
|
||||
****************************************************************************}
|
||||
|
||||
unit ppujson;
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes, ppuout;
|
||||
|
||||
type
|
||||
{ TPpuJsonOutput }
|
||||
|
||||
TPpuJsonOutput = class(TPpuOutput)
|
||||
private
|
||||
FNeedDelim: array of boolean;
|
||||
function JsonStr(const s: string): string;
|
||||
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 WriteArrayStart(const AName: string); override;
|
||||
procedure WriteArrayEnd(const AName: string); 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;
|
||||
public
|
||||
constructor Create(var OutFile: Text); override;
|
||||
procedure IncI; override;
|
||||
procedure DecI; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TPpuJsonOutput }
|
||||
|
||||
function TPpuJsonOutput.JsonStr(const s: string): string;
|
||||
var
|
||||
ws: widestring;
|
||||
ps: PWideChar;
|
||||
pd: PAnsiChar;
|
||||
i, slen, dlen, dpos: integer;
|
||||
|
||||
procedure _AddChar(c: ansichar);
|
||||
begin
|
||||
if dpos = dlen then begin
|
||||
dlen:=dlen*2;
|
||||
SetLength(Result, dlen);
|
||||
pd:=PAnsiChar(Result) + dpos;
|
||||
end;
|
||||
pd^:=c;
|
||||
Inc(pd);
|
||||
Inc(dpos);
|
||||
end;
|
||||
|
||||
var
|
||||
c: widechar;
|
||||
ss: shortstring;
|
||||
begin
|
||||
ws:=UTF8Decode(s);
|
||||
ps:=PWideChar(ws);
|
||||
slen:=Length(ws);
|
||||
dlen:=slen + 2;
|
||||
SetLength(Result, dlen);
|
||||
pd:=PAnsiChar(Result);
|
||||
dpos:=0;
|
||||
_AddChar('"');
|
||||
while slen > 0 do begin
|
||||
c:=ps^;
|
||||
case c of
|
||||
'"', '\', '/':
|
||||
begin
|
||||
_AddChar('\');
|
||||
_AddChar(c);
|
||||
end;
|
||||
#8:
|
||||
begin
|
||||
_AddChar('\');
|
||||
_AddChar('b');
|
||||
end;
|
||||
#9:
|
||||
begin
|
||||
_AddChar('\');
|
||||
_AddChar('t');
|
||||
end;
|
||||
#10:
|
||||
begin
|
||||
_AddChar('\');
|
||||
_AddChar('n');
|
||||
end;
|
||||
#13:
|
||||
begin
|
||||
_AddChar('\');
|
||||
_AddChar('r');
|
||||
end;
|
||||
#12:
|
||||
begin
|
||||
_AddChar('\');
|
||||
_AddChar('f');
|
||||
end;
|
||||
else
|
||||
if (c < #32) or (c > #127) then begin
|
||||
_AddChar('\');
|
||||
_AddChar('u');
|
||||
ss:=hexStr(integer(c), 4);
|
||||
for i:=1 to 4 do
|
||||
_AddChar(ss[i]);
|
||||
end
|
||||
else
|
||||
_AddChar(c);
|
||||
end;
|
||||
Inc(ps);
|
||||
Dec(slen);
|
||||
end;
|
||||
_AddChar('"');
|
||||
SetLength(Result, dpos);
|
||||
end;
|
||||
|
||||
procedure TPpuJsonOutput.BeforeWriteElement;
|
||||
begin
|
||||
if FNeedDelim[Indent] then
|
||||
WriteLn(',');
|
||||
FNeedDelim[Indent]:=True;
|
||||
end;
|
||||
|
||||
procedure TPpuJsonOutput.WriteAttr(const AName, AValue: string);
|
||||
begin
|
||||
BeforeWriteElement;
|
||||
if AName <> '' then
|
||||
Write(Format('"%s": %s', [AName, AValue]))
|
||||
else
|
||||
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));
|
||||
end;
|
||||
|
||||
procedure TPpuJsonOutput.WriteInt(const AName: string; AValue: Int64);
|
||||
begin
|
||||
WriteAttr(AName, IntToStr(AValue));
|
||||
end;
|
||||
|
||||
procedure TPpuJsonOutput.WriteFloat(const AName: string; AValue: extended);
|
||||
var
|
||||
s: string;
|
||||
begin
|
||||
Str(AValue, s);
|
||||
WriteAttr(AName, s);
|
||||
end;
|
||||
|
||||
procedure TPpuJsonOutput.WriteBool(const AName: string; AValue: boolean);
|
||||
begin
|
||||
if AValue then
|
||||
WriteAttr(AName, 'true')
|
||||
else
|
||||
WriteAttr(AName, 'false');
|
||||
end;
|
||||
|
||||
procedure TPpuJsonOutput.WriteArrayStart(const AName: string);
|
||||
begin
|
||||
BeforeWriteElement;
|
||||
WriteLn(Format('"%s": [', [AName]));
|
||||
IncI;
|
||||
end;
|
||||
|
||||
procedure TPpuJsonOutput.WriteArrayEnd(const AName: string);
|
||||
begin
|
||||
DecI;
|
||||
Write(']');
|
||||
end;
|
||||
|
||||
constructor TPpuJsonOutput.Create(var OutFile: Text);
|
||||
begin
|
||||
inherited Create(OutFile);
|
||||
SetLength(FNeedDelim, 10);
|
||||
FNeedDelim[0]:=False;
|
||||
end;
|
||||
|
||||
procedure TPpuJsonOutput.IncI;
|
||||
begin
|
||||
inherited IncI;
|
||||
if Length(FNeedDelim) >= Indent then
|
||||
SetLength(FNeedDelim, Indent + 1);
|
||||
FNeedDelim[Indent]:=False;
|
||||
end;
|
||||
|
||||
procedure TPpuJsonOutput.DecI;
|
||||
begin
|
||||
if FNeedDelim[Indent] then
|
||||
WriteLn;
|
||||
inherited DecI;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
405
compiler/utils/ppudump/ppuout.pp
Normal file
405
compiler/utils/ppudump/ppuout.pp
Normal file
@ -0,0 +1,405 @@
|
||||
{
|
||||
Copyright (c) 2013 by Yury Sidorov and the FPC Development Team
|
||||
|
||||
Base classes for a custom output of a PPU File
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation; either version 2 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program; if not, write to the Free Software
|
||||
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
||||
|
||||
****************************************************************************}
|
||||
|
||||
unit ppuout;
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses SysUtils, Classes;
|
||||
|
||||
type
|
||||
TPpuDefType = (dtNone, dtUnit, dtClass, dtRecord, dtProc, dtField, dtProp, dtParam, dtVar,
|
||||
dtType, dtConst, dtProcType, dtEnum, dtSet);
|
||||
|
||||
TPpuDef = class;
|
||||
TPpuContainerDef = class;
|
||||
|
||||
{ TPpuOutput }
|
||||
|
||||
TPpuOutput = class
|
||||
private
|
||||
FOutFile: ^Text;
|
||||
FIndent: integer;
|
||||
FIndentSize: integer;
|
||||
FIndStr: string;
|
||||
FNoIndent: boolean;
|
||||
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 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;
|
||||
public
|
||||
constructor Create(var OutFile: Text); virtual;
|
||||
destructor Destroy; override;
|
||||
procedure Write(const s: string);
|
||||
procedure WriteLn(const s: string = '');
|
||||
procedure IncI; virtual;
|
||||
procedure DecI; virtual;
|
||||
property Indent: integer read FIndent write SetIndent;
|
||||
property IndentSize: integer read FIndentSize write SetIndentSize;
|
||||
end;
|
||||
|
||||
{ TPpuDef }
|
||||
|
||||
TPpuDef = class
|
||||
private
|
||||
FParent: TPpuContainerDef;
|
||||
function GetDefTypeName: string;
|
||||
procedure SetProps(AValue: TStringList);
|
||||
|
||||
protected
|
||||
procedure WriteDef(Output: TPpuOutput); virtual;
|
||||
|
||||
public
|
||||
DefType: TPpuDefType;
|
||||
Name: string;
|
||||
DefId: integer;
|
||||
|
||||
constructor Create(AParent: TPpuContainerDef); virtual; reintroduce;
|
||||
destructor Destroy; override;
|
||||
procedure Write(Output: TPpuOutput);
|
||||
property Parent: TPpuContainerDef read FParent;
|
||||
property DefTypeName: string read GetDefTypeName;
|
||||
end;
|
||||
|
||||
{ TPpuContainerDef }
|
||||
|
||||
TPpuContainerDef = class(TPpuDef)
|
||||
private
|
||||
FItems: TList;
|
||||
function GetCount: integer;
|
||||
function GetItem(Index: Integer): TPpuDef;
|
||||
procedure SetItem(Index: Integer; AValue: TPpuDef);
|
||||
|
||||
protected
|
||||
procedure WriteDef(Output: TPpuOutput); override;
|
||||
|
||||
public
|
||||
ItemsName: string;
|
||||
|
||||
constructor Create(AParent: TPpuContainerDef); override;
|
||||
destructor Destroy; override;
|
||||
function Add(Def: TPpuDef): integer;
|
||||
property Items[Index: Integer]: TPpuDef read GetItem write SetItem; default;
|
||||
property Count: integer read GetCount;
|
||||
end;
|
||||
|
||||
{ TPpuUnitDef }
|
||||
|
||||
TPpuUnitDef = class(TPpuContainerDef)
|
||||
protected
|
||||
procedure WriteDef(Output: TPpuOutput); override;
|
||||
public
|
||||
Version: cardinal;
|
||||
Crc, IntfCrc: cardinal;
|
||||
TargetOS, TargetCPU: string;
|
||||
UsedUnits: TPpuContainerDef;
|
||||
RefUnits: array of string;
|
||||
SourceFiles: TPpuContainerDef;
|
||||
constructor Create(AParent: TPpuContainerDef); override;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
{ TPpuSrcFile }
|
||||
|
||||
TPpuSrcFile = class(TPpuDef)
|
||||
protected
|
||||
procedure WriteDef(Output: TPpuOutput); override;
|
||||
public
|
||||
FileTime: TDateTime;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
const
|
||||
DefTypeNames: array[TPpuDefType] of string =
|
||||
('', 'unit', 'class', 'record', 'procedure', 'field', 'property', 'parameter', 'variable',
|
||||
'type', 'constant', 'proctype', 'enum', 'set');
|
||||
|
||||
{ TPpuSrcFile }
|
||||
|
||||
procedure TPpuSrcFile.WriteDef(Output: TPpuOutput);
|
||||
begin
|
||||
inherited WriteDef(Output);
|
||||
Output.WriteStr('Time', FormatDateTime('yyyy"-"mm"-"dd hh":"nn":"ss', FileTime));
|
||||
end;
|
||||
|
||||
{ TPpuOutput }
|
||||
|
||||
procedure TPpuOutput.SetIndent(AValue: integer);
|
||||
begin
|
||||
if FIndent=AValue then Exit;
|
||||
FIndent:=AValue;
|
||||
if FIndent < 0 then
|
||||
FIndent:=0;
|
||||
SetLength(FIndStr, FIndent*IndentSize);
|
||||
if FIndent > 0 then
|
||||
FillChar(FIndStr[1], FIndent*IndentSize, ' ');
|
||||
end;
|
||||
|
||||
procedure TPpuOutput.SetIndentSize(AValue: integer);
|
||||
begin
|
||||
if FIndentSize=AValue then Exit;
|
||||
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;
|
||||
|
||||
procedure TPpuOutput.WriteInt(const AName: string; AValue: Int64);
|
||||
begin
|
||||
WriteStr(AName, IntToStr(AValue));
|
||||
end;
|
||||
|
||||
procedure TPpuOutput.WriteFloat(const AName: string; AValue: extended);
|
||||
var
|
||||
s: string;
|
||||
begin
|
||||
Str(AValue, s);
|
||||
WriteStr(AName, s);
|
||||
end;
|
||||
|
||||
procedure TPpuOutput.WriteBool(const AName: string; AValue: boolean);
|
||||
var
|
||||
s: string;
|
||||
begin
|
||||
if AValue then
|
||||
s:='1'
|
||||
else
|
||||
s:='0';
|
||||
WriteStr(AName, s);
|
||||
end;
|
||||
|
||||
procedure TPpuOutput.WriteArrayStart(const AName: string);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TPpuOutput.WriteArrayEnd(const AName: string);
|
||||
begin
|
||||
end;
|
||||
|
||||
constructor TPpuOutput.Create(var OutFile: Text);
|
||||
begin
|
||||
FOutFile:=@OutFile;
|
||||
FIndentSize:=2;
|
||||
end;
|
||||
|
||||
destructor TPpuOutput.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TPpuOutput.Write(const s: string);
|
||||
begin
|
||||
if not FNoIndent then
|
||||
System.Write(FOutFile^, FIndStr);
|
||||
System.Write(FOutFile^, s);
|
||||
FNoIndent:=True;
|
||||
end;
|
||||
|
||||
procedure TPpuOutput.WriteLn(const s: string);
|
||||
begin
|
||||
Self.Write(s + LineEnding);
|
||||
FNoIndent:=False;
|
||||
end;
|
||||
|
||||
procedure TPpuOutput.IncI;
|
||||
begin
|
||||
Indent:=Indent + 1;
|
||||
end;
|
||||
|
||||
procedure TPpuOutput.DecI;
|
||||
begin
|
||||
Indent:=Indent - 1;
|
||||
end;
|
||||
|
||||
{ TPpuUnitDef }
|
||||
|
||||
procedure TPpuUnitDef.WriteDef(Output: TPpuOutput);
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
with Output do begin
|
||||
if Version <> 0 then
|
||||
WriteInt('Version', Version);
|
||||
if TargetCPU <> '' then
|
||||
WriteStr('TargetCPU', TargetCPU);
|
||||
if TargetOS <> '' then
|
||||
WriteStr('TargetOS', TargetOS);
|
||||
if Crc <> 0 then
|
||||
WriteStr('Crc', hexStr(Crc, 8));
|
||||
if IntfCrc <> 0 then
|
||||
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');
|
||||
end;
|
||||
SourceFiles.WriteDef(Output);
|
||||
end;
|
||||
inherited WriteDef(Output);
|
||||
end;
|
||||
|
||||
constructor TPpuUnitDef.Create(AParent: TPpuContainerDef);
|
||||
begin
|
||||
inherited Create(AParent);
|
||||
DefType:=dtUnit;
|
||||
UsedUnits:=TPpuContainerDef.Create(nil);
|
||||
UsedUnits.FParent:=Self;
|
||||
UsedUnits.ItemsName:='UsedUnits';
|
||||
SourceFiles:=TPpuContainerDef.Create(nil);
|
||||
SourceFiles.FParent:=Self;
|
||||
SourceFiles.ItemsName:='SrcFiles';
|
||||
end;
|
||||
|
||||
destructor TPpuUnitDef.Destroy;
|
||||
begin
|
||||
UsedUnits.Free;
|
||||
SourceFiles.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
{ TPpuContainerDef }
|
||||
|
||||
function TPpuContainerDef.GetCount: integer;
|
||||
begin
|
||||
Result:=FItems.Count;
|
||||
end;
|
||||
|
||||
function TPpuContainerDef.GetItem(Index: Integer): TPpuDef;
|
||||
begin
|
||||
Result:=TPpuDef(FItems[Index]);
|
||||
end;
|
||||
|
||||
procedure TPpuContainerDef.SetItem(Index: Integer; AValue: TPpuDef);
|
||||
begin
|
||||
FItems[Index]:=AValue;
|
||||
end;
|
||||
|
||||
procedure TPpuContainerDef.WriteDef(Output: TPpuOutput);
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
inherited WriteDef(Output);
|
||||
if Count = 0 then
|
||||
exit;
|
||||
Output.WriteSubItemsStart(Self);
|
||||
if Parent <> nil then
|
||||
Output.IncI;
|
||||
for i:=0 to Count - 1 do
|
||||
Items[i].Write(Output);
|
||||
if Parent <> nil then
|
||||
Output.DecI;
|
||||
Output.WriteSubItemsEnd(Self);
|
||||
end;
|
||||
|
||||
constructor TPpuContainerDef.Create(AParent: TPpuContainerDef);
|
||||
begin
|
||||
inherited Create(AParent);
|
||||
FItems:=TList.Create;
|
||||
ItemsName:='Contents';
|
||||
end;
|
||||
|
||||
destructor TPpuContainerDef.Destroy;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
for i:=0 to FItems.Count - 1 do
|
||||
TObject(FItems[i]).Free;
|
||||
FItems.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TPpuContainerDef.Add(Def: TPpuDef): integer;
|
||||
begin
|
||||
Result:=FItems.Add(Def);
|
||||
Def.FParent:=Self;
|
||||
end;
|
||||
|
||||
{ TPpuDef }
|
||||
|
||||
function TPpuDef.GetDefTypeName: string;
|
||||
begin
|
||||
Result:=DefTypeNames[DefType];
|
||||
end;
|
||||
|
||||
procedure TPpuDef.SetProps(AValue: TStringList);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TPpuDef.WriteDef(Output: TPpuOutput);
|
||||
begin
|
||||
with Output do begin
|
||||
if DefId >= 0 then
|
||||
WriteInt('Id', DefId);
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TPpuDef.Create(AParent: TPpuContainerDef);
|
||||
begin
|
||||
DefId:=-1;
|
||||
if AParent <> nil then
|
||||
AParent.Add(Self);
|
||||
end;
|
||||
|
||||
destructor TPpuDef.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TPpuDef.Write(Output: TPpuOutput);
|
||||
begin
|
||||
Output.WriteDefStart(Self);
|
||||
WriteDef(Output);
|
||||
Output.WriteDefEnd(Self);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user