* ppudump: JSON output of classes.

git-svn-id: trunk@24317 -

compiler/utils/ppuutils/ppudump.pp

@@ -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);

compiler/utils/ppuutils/ppuout.pp

@@ -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,21 +207,40 @@ 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
 
@@ -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.