paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 18:09:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

* ppudump: JSON output of classes.

Browse Source 
git-svn-id: trunk@24317 -
This commit is contained in:
yury 2013-04-25 10:03:29 +00:00
parent 7ad68debc9
commit d265e8d3be
2 changed files with 203 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

88
compiler/utils/ppuutils/ppudump.pp
View File

@ -1763,7 +1763,17 @@ var
first : boolean;
begin
readcommonsym(s, VarDef);
writeln([space,' Spez : ',Varspez2Str(ppufile.getbyte)]);
i:=ppufile.getbyte;
if (VarDef <> nil) and (VarDef.DefType = dtParam) then
with TPpuParamDef(VarDef) do
case tvarspez(i) of
vs_value: Spez:=psValue;
vs_var: Spez:=psVar;
vs_out: Spez:=psOut;
vs_const: Spez:=psConst;
vs_constref: Spez:=psConstRef;
end;
writeln([space,' Spez : ',Varspez2Str(i)]);
writeln([space,' Regable : ',Varregable2Str(ppufile.getbyte)]);
writeln([space,' Addr Taken : ',(ppufile.getbyte<>0)]);
write ([space,' Var Type : ']);
@ -1774,6 +1784,8 @@ begin
ppufile.getsmallset(varoptions);
if varoptions<>[] then
begin
if (VarDef <> nil) and (VarDef.DefType = dtParam) and (vo_is_hidden_para in varoptions) then
TPpuParamDef(VarDef).Spez:=psHidden;
write([space,' Options : ']);
first:=true;
for i:=1 to high(varopt) do
@ -1792,7 +1804,7 @@ begin
end;
procedure readobjectdefoptions;
procedure readobjectdefoptions(ObjDef: TPpuObjectDef = nil);
type
tsymopt=record
mask : tobjectoption;
@ -1833,6 +1845,11 @@ begin
ppufile.getsmallset(current_objectoptions);
if current_objectoptions<>[] then
begin
if ObjDef <> nil then
begin
if oo_is_abstract in current_objectoptions then
Include(ObjDef.Options, ooIsAbstract);
end;
first:=true;
for i:=1 to high(symopt) do
if (symopt[i].mask in current_objectoptions) then
@ -2030,6 +2047,24 @@ end;
****************************************************************************}
procedure readsymbols(const s:string; ParentDef: TPpuContainerDef = nil);
function _finddef(symdef: TPpuDef): TPpuDef;
begin
Result:=nil;
if symdef.Ref.IsCurUnit then
begin;
Result:=CurUnit.FindById(symdef.Ref.Id);
if (Result <> nil) and (Result.Ref.Id = symdef.Id) then
begin
Result.Name:=symdef.Name;
Result.FilePos:=symdef.FilePos;
Result.Visibility:=symdef.Visibility;
end
else
Result:=nil;
end;
end;
type
pguid = ^tguid;
tguid = packed record
@ -2055,7 +2090,7 @@ var
pw : pcompilerwidestring;
varoptions : tvaroptions;
propoptions : tpropertyoptions;
def, def2: TPpuDef;
def: TPpuDef;
begin
with ppufile do
begin
@ -2087,9 +2122,14 @@ begin
ibtypesym :
begin
readcommonsym('Type symbol ');
def:=TPpuTypeRef.Create(nil);
readcommonsym('Type symbol ',def);
write([space,' Result Type : ']);
readderef('');
readderef('', def.Ref);
if _finddef(def) = nil then
def.Parent:=ParentDef
else
def.Free;
prettyname:=getansistring;
if prettyname<>'' then
begin
@ -2107,15 +2147,7 @@ begin
begin
write([space,' Definition : ']);
readderef('', def.Ref);
if def.Ref.IsCurUnit then
begin;
def2:=CurUnit.FindById(def.Ref.Id);
if (def2 <> nil) and (def2.Ref.Id = def.Id) then
begin
def2.Name:=def.Name;
def2.FilePos:=def.FilePos;
end;
end;
_finddef(def);
end;
def.Free;
end;
@ -2279,7 +2311,8 @@ begin
ibfieldvarsym :
begin
readabstractvarsym('Field Variable symbol ',varoptions);
def:=TPpuFieldDef.Create(ParentDef);
readabstractvarsym('Field Variable symbol ',varoptions,TPpuVarDef(def));
writeln([space,' Address : ',getaint]);
end;
@ -2429,6 +2462,7 @@ var
defoptions: tdefoptions;
procdef: TPpuProcDef;
ptypedef: TPpuProcTypeDef;
objdef: TPpuObjectDef;
begin
with ppufile do
begin
@ -2647,11 +2681,13 @@ begin
ibobjectdef :
begin
readcommondef('Object/Class definition',defoptions);
writeln([space,' Name of Class : ',getstring]);
objdef:=TPpuObjectDef.Create(ParentDef);
readcommondef('Object/Class definition',defoptions,objdef);
objdef.Name:=getstring;
writeln([space,' Name of Class : ',objdef.Name]);
writeln([space,' Import lib/pkg : ',getstring]);
write ([space,' Options : ']);
readobjectdefoptions;
readobjectdefoptions(objdef);
b:=getbyte;
write ([space,' Type : ']);
case tobjecttyp(b) of
@ -2669,6 +2705,16 @@ begin
odt_interfacejava : writeln('Java interface');
else writeln(['!! Warning: Invalid object type ',b]);
end;
case tobjecttyp(b) of
odt_class, odt_cppclass, odt_objcclass, odt_javaclass:
objdef.ObjType:=otClass;
odt_object:
objdef.ObjType:=otObject;
odt_interfacecom, odt_interfacecorba, odt_interfacejava, odt_dispinterface:
objdef.ObjType:=otInterface;
odt_helper:
objdef.ObjType:=otHelper;
end;
writeln([space,' External name : ',getstring]);
writeln([space,' DataSize : ',getasizeint]);
writeln([space,' PaddingSize : ',getword]);
@ -2676,7 +2722,7 @@ begin
writeln([space,' RecordAlign : ',shortint(getbyte)]);
writeln([space,' Vmt offset : ',getlongint]);
write ([space, ' Ancestor Class : ']);
readderef('');
readderef('',objdef.Ancestor);
if tobjecttyp(b) in [odt_interfacecom,odt_interfacecorba,odt_dispinterface] then
begin
@ -2733,7 +2779,7 @@ begin
{read the record definitions and symbols}
space:=' '+space;
readrecsymtableoptions;
readsymtable('fields');
readsymtable('fields',objdef);
Delete(space,1,4);
end;
end;
@ -3143,7 +3189,7 @@ begin
Writeln;
Writeln('Interface Symbols');
Writeln('------------------');
readsymbols('interface');
readsymbols('interface',CurUnit);
end
else
ppufile.skipuntilentry(ibendsyms);

148
compiler/utils/ppuutils/ppuout.pp
View File

@ -29,7 +29,7 @@ uses SysUtils, cclasses, Classes;
type
TPpuDefType = (dtNone, dtUnit, dtObject, dtRecord, dtProc, dtField, dtProp, dtParam, dtVar,
dtType, dtConst, dtProcType, dtEnum, dtSet);
dtTypeRef, dtConst, dtProcType, dtEnum, dtSet);
TPpuDef = class;
TPpuContainerDef = class;
@ -95,6 +95,7 @@ type
function GetId: cardinal;
function GetParentUnit: TPpuUnitDef;
procedure SetId(AValue: cardinal);
procedure SetParent(AValue: TPpuContainerDef);
protected
procedure WriteDef(Output: TPpuOutput); virtual;
@ -110,8 +111,9 @@ type
constructor Create(AParent: TPpuContainerDef); virtual; reintroduce;
destructor Destroy; override;
procedure Write(Output: TPpuOutput);
function CanWrite: boolean; virtual;
procedure SetSymId(AId: integer);
property Parent: TPpuContainerDef read FParent;
property Parent: TPpuContainerDef read FParent write SetParent;
property ParentUnit: TPpuUnitDef read GetParentUnit;
property Id: cardinal read GetId write SetId;
property DefTypeName: string read GetDefTypeName;
@ -139,6 +141,14 @@ type
property Count: integer read GetCount;
end;
{ TPpuTypeRef }
TPpuTypeRef = class(TPpuDef)
protected
procedure WriteDef(Output: TPpuOutput); override;
public
constructor Create(AParent: TPpuContainerDef); override;
end;
{ TPpuUnitDef }
TPpuUnitDef = class(TPpuContainerDef)
private
@ -188,7 +198,6 @@ type
end;
{ TPpuVarDef }
TPpuVarDef = class(TPpuDef)
protected
procedure WriteDef(Output: TPpuOutput); override;
@ -198,22 +207,41 @@ type
destructor Destroy; override;
end;
{ TPpuParamDef }
TPpuParamSpez = (psValue, psVar, psOut, psConst, psConstRef, psHidden);
{ TPpuParamDef }
TPpuParamDef = class(TPpuVarDef)
protected
procedure WriteDef(Output: TPpuOutput); override;
public
Spez: TPpuParamSpez;
constructor Create(AParent: TPpuContainerDef); override;
function CanWrite: boolean; override;
end;
TPpuObjType = (otUnknown, otClass, otObject, otInterface, otHelper);
TPpuObjOption = (ooIsAbstract);
TPpuObjOptions = set of TPpuObjOption;
{ TPpuObjectDef }
TPpuObjectDef = class(TPpuContainerDef)
protected
procedure BeforeWriteItems(Output: TPpuOutput); override;
public
ObjType: TPpuObjType;
Ancestor: TPpuRef;
Options: TPpuObjOptions;
constructor Create(AParent: TPpuContainerDef); override;
destructor Destroy; override;
function CanWrite: boolean; override;
end;
{ TPpuFieldDef }
TPpuFieldDef = class(TPpuVarDef)
public
constructor Create(AParent: TPpuContainerDef); override;
end;
implementation
const
@ -222,11 +250,20 @@ const
'type', 'const', 'proctype', 'enum', 'set');
ProcOptionNames: array[TPpuProcOption] of string =
('Procedure', 'Function', 'Constructor', 'Destructor', 'Operator',
'ClassMethod', 'Virtual', 'Abstract', 'Overriding', 'Overload', 'Inline');
('procedure', 'function', 'constructor', 'destructor', 'operator',
'classmethod', 'virtual', 'abstract', 'overriding', 'overload', 'inline');
DefVisibilityNames: array[TPpuDefVisibility] of string =
('Public', 'Published', 'Protected', 'Private');
('public', 'published', 'protected', 'private');
ParamSpezNames: array[TPpuParamSpez] of string =
('value', 'var', 'out', 'const', 'constref', '');
ObjTypeNames: array[TPpuObjType] of string =
('', 'class', 'object', 'interface', 'helper');
ObjOptionNames: array[TPpuObjOption] of string =
('abstract');
SymIdBit = $80000000;
InvalidId = cardinal(-1);
@ -237,12 +274,47 @@ begin
Result:=Id and SymIdBit <> 0;
end;
{ TPpuTypeRef }
procedure TPpuTypeRef.WriteDef(Output: TPpuOutput);
begin
inherited WriteDef(Output);
Ref.Write(Output, 'TypeRef');
end;
constructor TPpuTypeRef.Create(AParent: TPpuContainerDef);
begin
inherited Create(AParent);
DefType:=dtTypeRef;
end;
{ TPpuFieldDef }
constructor TPpuFieldDef.Create(AParent: TPpuContainerDef);
begin
inherited Create(AParent);
DefType:=dtField;
end;
{ TPpuParamDef }
procedure TPpuParamDef.WriteDef(Output: TPpuOutput);
begin
inherited WriteDef(Output);
if Spez <> psValue then
Output.WriteStr('Spez', ParamSpezNames[Spez]);
end;
constructor TPpuParamDef.Create(AParent: TPpuContainerDef);
begin
inherited Create(AParent);
DefType:=dtParam;
Spez:=psValue;
end;
function TPpuParamDef.CanWrite: boolean;
begin
Result:=Spez <> psHidden;
end;
{ TPpuVarDef }
@ -268,10 +340,40 @@ end;
{ TPpuObjectDef }
procedure TPpuObjectDef.BeforeWriteItems(Output: TPpuOutput);
var
opt: TPpuObjOption;
begin
inherited BeforeWriteItems(Output);
if Options <> [] then begin
Output.WriteArrayStart('Options');
for opt:=Low(opt) to High(opt) do
if opt in Options then
Output.WriteStr('', ObjOptionNames[opt]);
Output.WriteArrayEnd;
end;
Output.WriteStr('ObjType', ObjTypeNames[ObjType]);
Ancestor.Write(Output, 'Ancestor');
end;
constructor TPpuObjectDef.Create(AParent: TPpuContainerDef);
begin
inherited Create(AParent);
DefType:=dtObject;
ItemsName:='Fields';
ObjType:=otUnknown;
Ancestor:=TPpuRef.Create;
end;
destructor TPpuObjectDef.Destroy;
begin
Ancestor.Free;
inherited Destroy;
end;
function TPpuObjectDef.CanWrite: boolean;
begin
Result:=ObjType <> otUnknown;
end;
{ TPpuRef }
@ -323,13 +425,13 @@ begin
inherited BeforeWriteItems(Output);
if Options <> [] then begin
Output.WriteArrayStart('Options');
for opt:=Low(TPpuProcOption) to High(TPpuProcOption) do
for opt:=Low(opt) to High(opt) do
if opt in Options then
Output.WriteStr('', ProcOptionNames[opt]);
Output.WriteArrayEnd;
end;
ReturnType.Write(Output, 'RetType');
if Options*[poProcedure, poDestructor] = [] then
ReturnType.Write(Output, 'RetType');
end;
constructor TPpuProcDef.Create(AParent: TPpuContainerDef);
@ -639,6 +741,21 @@ begin
end;
end;
procedure TPpuDef.SetParent(AValue: TPpuContainerDef);
var
i: cardinal;
begin
if FParent=AValue then Exit;
if FParent <> nil then
raise Exception.Create('Parent can not be modified.');
AValue.Add(Self);
if FId <> InvalidId then begin
i:=FId;
FId:=InvalidId;
SetId(i);
end;
end;
procedure TPpuDef.SetSymId(AId: integer);
begin
Id:=cardinal(AId) or SymIdBit;
@ -685,6 +802,8 @@ end;
procedure TPpuDef.Write(Output: TPpuOutput);
begin
if not CanWrite then
exit;
if Parent <> nil then
Output.WriteObjectStart('', Self);
WriteDef(Output);
@ -692,5 +811,10 @@ begin
Output.WriteObjectEnd(Self);
end;
function TPpuDef.CanWrite: boolean;
begin
Result:=True;
end;
end.