* ppudump: Work in progress on JSON output. Implemented procedure definition.

git-svn-id: trunk@24316 -

compiler/utils/ppuutils/ppudump.pp

@@ -620,13 +620,13 @@ begin
 end;
 
 procedure readdefinitions(const s:string; ParentDef: TPpuContainerDef); forward;
-procedure readsymbols(const s:string); forward;
+procedure readsymbols(const s:string; ParentDef: TPpuContainerDef = nil); forward;
 
 procedure readsymtable(const s: string; ParentDef: TPpuContainerDef = nil);
 begin
   readsymtableoptions(s);
   readdefinitions(s, ParentDef);
-  readsymbols(s);
+  readsymbols(s, ParentDef);
 end;
 
 Procedure ReadLinkContainer(const prefix:string);
@@ -947,6 +947,8 @@ 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(['SymId ',idx]);
+           if Ref <> nil then
+             Ref.Id:=idx;
          end;
        deref_defid :
          begin
@@ -1231,14 +1233,38 @@ begin
     writeln([space,'Deprecated : ', ppufile.getstring]);
 end;
 
+procedure readvisibility(Def: TPpuDef = nil);
+var
+  i: byte;
+begin
+  i:=ppufile.getbyte;
+  if Def <> nil then
+    case tvisibility(i) of
+      vis_public: Def.Visibility:=dvPublic;
+      vis_published: Def.Visibility:=dvPublished;
+      vis_protected, vis_strictprotected: Def.Visibility:=dvProtected;
+      else Def.Visibility:=dvPrivate;
+    end;
+  writeln(Visibility2Str(i));
+end;
 
 procedure readcommonsym(const s:string; Def: TPpuDef = nil);
+var
+  i: integer;
+  n: string;
 begin
-  writeln([space,'** Symbol Id ',ppufile.getlongint,' **']);
-  writeln([space,s,ppufile.getstring]);
+  i:=ppufile.getlongint;
+  if Def <> nil then
+    Def.SetSymId(i);
+  writeln([space,'** Symbol Id ',i,' **']);
+  n:=ppufile.getstring;
+  if Def <> nil then
+    Def.Name:=n;
+  writeln([space,s,n]);
   write  ([space,'     File Pos : ']);
-  readposinfo;
-  writeln([space,'   Visibility : ',Visibility2Str(ppufile.getbyte)]);
+  readposinfo(Def);
+  write  ([space,'   Visibility : ']);
+  readvisibility(Def);
   write  ([space,'   SymOptions : ']);
   readsymoptions(space+'   ');
 end;
@@ -1377,7 +1403,10 @@ begin
   writeln([space,'** Definition Id ',i,' **']);
   writeln([space,s]);
   write  ([space,'      Type symbol : ']);
-  readderef('');
+  if Def <> nil then
+    readderef('', Def.Ref)
+  else
+    readderef('');
   write  ([space,'       DefOptions : ']);
   ppufile.getsmallset(defoptions);
   if defoptions<>[] then
@@ -1637,6 +1666,13 @@ begin
   readderef('', ProcDef.ReturnType);
   writeln([space,'         Fpu used : ',ppufile.getbyte]);
   proctypeoption:=tproctypeoption(ppufile.getbyte);
+  case proctypeoption of
+    potype_function: Include(ProcDef.Options, poFunction);
+    potype_procedure: Include(ProcDef.Options, poProcedure);
+    potype_constructor: Include(ProcDef.Options, poConstructor);
+    potype_destructor: Include(ProcDef.Options, poDestructor);
+    potype_operator: Include(ProcDef.Options, poOperator);
+  end;
   write([space,'       TypeOption : ']);
   first:=true;
   for i:=1 to high(proctypeopt) do
@@ -1654,6 +1690,13 @@ begin
   ppufile.getnormalset(procoptions);
   if procoptions<>[] then
    begin
+     if po_classmethod in procoptions then Include(ProcDef.Options, poClassMethod);
+     if po_virtualmethod in procoptions then Include(ProcDef.Options, poVirtual);
+     if po_abstractmethod in procoptions then Include(ProcDef.Options, poAbstract);
+     if po_overridingmethod in procoptions then Include(ProcDef.Options, poOverriding);
+     if po_overload in procoptions then Include(ProcDef.Options, poOverload);
+     if po_inline in procoptions then Include(ProcDef.Options, poInline);
+
      write([space,'          Options : ']);
      first:=true;
      for i:=1 to high(procopt) do
@@ -1678,7 +1721,7 @@ end;
 { type tvaroption is in unit symconst }
   { register variable }
 { type tvarregable is in unit symconst }
-procedure readabstractvarsym(const s:string;var varoptions:tvaroptions);
+procedure readabstractvarsym(const s:string;var varoptions:tvaroptions; VarDef: TPpuVarDef = nil);
 type
   tvaropt=record
     mask : tvaroption;
@@ -1719,12 +1762,15 @@ var
   i : longint;
   first : boolean;
 begin
-  readcommonsym(s);
+  readcommonsym(s, VarDef);
   writeln([space,'         Spez : ',Varspez2Str(ppufile.getbyte)]);
   writeln([space,'      Regable : ',Varregable2Str(ppufile.getbyte)]);
   writeln([space,'   Addr Taken : ',(ppufile.getbyte<>0)]);
   write  ([space,'     Var Type : ']);
-  readderef('');
+  if VarDef <> nil then
+    readderef('',VarDef.VarType)
+  else
+    readderef('');
   ppufile.getsmallset(varoptions);
   if varoptions<>[] then
    begin
@@ -1983,7 +2029,7 @@ end;
                              Read Symbols Part
 ****************************************************************************}
 
-procedure readsymbols(const s:string);
+procedure readsymbols(const s:string; ParentDef: TPpuContainerDef = nil);
 type
   pguid = ^tguid;
   tguid = packed record
@@ -2009,6 +2055,7 @@ var
   pw : pcompilerwidestring;
   varoptions : tvaroptions;
   propoptions : tpropertyoptions;
+  def, def2: TPpuDef;
 begin
   with ppufile do
    begin
@@ -2053,13 +2100,24 @@ begin
 
          ibprocsym :
            begin
-             readcommonsym('Procedure symbol ');
+             def:=TPpuDef.Create(nil);
+             readcommonsym('Procedure symbol ', def);
              len:=ppufile.getword;
              for i:=1 to len do
               begin
                 write([space,'   Definition : ']);
-                readderef('');
+                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;
               end;
+             def.Free;
            end;
 
          ibconstsym :
@@ -2247,7 +2305,8 @@ begin
 
          ibparavarsym :
            begin
-             readabstractvarsym('Parameter Variable symbol ',varoptions);
+             def:=TPpuParamDef.Create(ParentDef);
+             readabstractvarsym('Parameter Variable symbol ',varoptions,TPpuVarDef(def));
              write  ([space,' DefaultConst : ']);
              readderef('');
              writeln([space,'       ParaNr : ',getword]);
@@ -2452,10 +2511,11 @@ begin
              write  ([space,'            Class : ']);
              readderef('');
              write  ([space,'          Procsym : ']);
-             readderef('');
+             readderef('', procdef.Ref);
              write  ([space,'         File Pos : ']);
              readposinfo(procdef);
-             writeln([space,'       Visibility : ',Visibility2Str(ppufile.getbyte)]);
+             write  ([space,'       Visibility : ']);
+             readvisibility(procdef);
              write  ([space,'       SymOptions : ']);
              readsymoptions(space+'       ');
              write  ([space,'   Synthetic kind : ',Synthetic2Str(ppufile.getbyte)]);
@@ -2499,7 +2559,7 @@ begin
                HasMoreInfos;
              space:='    '+space;
              { parast }
-             readsymtable('parast');
+             readsymtable('parast', procdef);
              { localst }
              if (po_has_inlininginfo in procoptions) then
                 readsymtable('localst');
@@ -2641,7 +2701,8 @@ begin
                begin
                  write([space,'    ']);
                  readderef('');
-                 writeln([space,'      Visibility: ',Visibility2Str(getbyte)]);
+                 write([space,'      Visibility: ']);
+                 readvisibility;
                end;
 
              if tobjecttyp(b) in [odt_class,odt_objcclass,odt_objcprotocol,odt_javaclass,odt_interfacejava] then

compiler/utils/ppuutils/ppuout.pp

@@ -70,9 +70,11 @@ type
   TPpuRef = class
   public
     UnitIndex: word;
-    Id: integer;
+    Id: cardinal;
     constructor Create;
     procedure Write(Output: TPpuOutput; const RefName: string);
+    function IsCurUnit: boolean; inline;
+    function IsNull: boolean; inline;
   end;
 
   TPpuFilePos = record
@@ -80,16 +82,19 @@ type
     Line, Col: integer;
   end;
 
+  TPpuDefVisibility = (dvPublic, dvPublished, dvProtected, dvPrivate);
+
   { TPpuDef }
 
   TPpuDef = class
   private
-    FId: integer;
+    FId: cardinal;
     FParent: TPpuContainerDef;
     FParentUnit: TPpuUnitDef;
     function GetDefTypeName: string;
+    function GetId: cardinal;
     function GetParentUnit: TPpuUnitDef;
-    procedure SetId(AValue: integer);
+    procedure SetId(AValue: cardinal);
 
   protected
     procedure WriteDef(Output: TPpuOutput); virtual;
@@ -98,13 +103,17 @@ type
     DefType: TPpuDefType;
     Name: string;
     FilePos: TPpuFilePos;
+    // Symbol/definition reference
+    Ref: TPpuRef;
+    Visibility: TPpuDefVisibility;
 
     constructor Create(AParent: TPpuContainerDef); virtual; reintroduce;
     destructor Destroy; override;
     procedure Write(Output: TPpuOutput);
+    procedure SetSymId(AId: integer);
     property Parent: TPpuContainerDef read FParent;
     property ParentUnit: TPpuUnitDef read GetParentUnit;
-    property Id: integer read FId write SetId;
+    property Id: cardinal read GetId write SetId;
     property DefTypeName: string read GetDefTypeName;
   end;
 
@@ -118,6 +127,7 @@ type
 
   protected
     procedure WriteDef(Output: TPpuOutput); override;
+    procedure BeforeWriteItems(Output: TPpuOutput); virtual;
 
   public
     ItemsName: string;
@@ -145,7 +155,7 @@ type
 
     constructor Create(AParent: TPpuContainerDef); override;
     destructor Destroy; override;
-    function FindById(AId: integer): TPpuDef;
+    function FindById(AId: integer; FindSym: boolean = False): TPpuDef;
   end;
 
   { TPpuSrcFile }
@@ -156,12 +166,17 @@ type
     FileTime: TDateTime;
   end;
 
+  TPpuProcOption = (poProcedure, poFunction, poConstructor, poDestructor, poOperator,
+                    poClassMethod, poVirtual, poAbstract, poOverriding, poOverload, poInline);
+  TPpuProcOptions = set of TPpuProcOption;
+
   { TPpuProcDef }
   TPpuProcDef = class(TPpuContainerDef)
   protected
-    procedure WriteDef(Output: TPpuOutput); override;
+    procedure BeforeWriteItems(Output: TPpuOutput); override;
   public
     ReturnType: TPpuRef;
+    Options: TPpuProcOptions;
     constructor Create(AParent: TPpuContainerDef); override;
     destructor Destroy; override;
   end;
@@ -172,35 +187,125 @@ type
     constructor Create(AParent: TPpuContainerDef); override;
   end;
 
+  { TPpuVarDef }
+
+  TPpuVarDef = class(TPpuDef)
+  protected
+    procedure WriteDef(Output: TPpuOutput); override;
+  public
+    VarType: TPpuRef;
+    constructor Create(AParent: TPpuContainerDef); override;
+    destructor Destroy; override;
+  end;
+
+  { TPpuParamDef }
+
+  TPpuParamDef = class(TPpuVarDef)
+  public
+    constructor Create(AParent: TPpuContainerDef); override;
+  end;
+
+
+  { TPpuObjectDef }
+
+  TPpuObjectDef = class(TPpuContainerDef)
+  public
+    constructor Create(AParent: TPpuContainerDef); override;
+  end;
+
+
 implementation
 
 const
   DefTypeNames: array[TPpuDefType] of string =
-    ('', 'unit', 'object', 'record', 'procedure', 'field', 'property', 'parameter', 'variable',
-     'type', 'constant', 'proctype', 'enum', 'set');
+    ('', 'unit', 'obj', 'rec', 'proc', 'field', 'prop', 'param', 'var',
+     'type', 'const', 'proctype', 'enum', 'set');
+
+  ProcOptionNames: array[TPpuProcOption] of string =
+    ('Procedure', 'Function', 'Constructor', 'Destructor', 'Operator',
+     'ClassMethod', 'Virtual', 'Abstract', 'Overriding', 'Overload', 'Inline');
+
+  DefVisibilityNames: array[TPpuDefVisibility] of string =
+    ('Public', 'Published', 'Protected', 'Private');
+
+  SymIdBit = $80000000;
+  InvalidId = cardinal(-1);
+  InvalidUnit = word(-1);
+
+function IsSymId(Id: cardinal): boolean; inline;
+begin
+  Result:=Id and SymIdBit <> 0;
+end;
+
+{ TPpuParamDef }
+
+constructor TPpuParamDef.Create(AParent: TPpuContainerDef);
+begin
+  inherited Create(AParent);
+  DefType:=dtParam;
+end;
+
+{ TPpuVarDef }
+
+procedure TPpuVarDef.WriteDef(Output: TPpuOutput);
+begin
+  inherited WriteDef(Output);
+  VarType.Write(Output, 'VarType');
+end;
+
+constructor TPpuVarDef.Create(AParent: TPpuContainerDef);
+begin
+  inherited Create(AParent);
+  DefType:=dtVar;
+  VarType:=TPpuRef.Create;
+end;
+
+destructor TPpuVarDef.Destroy;
+begin
+  VarType.Free;
+  inherited Destroy;
+end;
+
+{ TPpuObjectDef }
+
+constructor TPpuObjectDef.Create(AParent: TPpuContainerDef);
+begin
+  inherited Create(AParent);
+  DefType:=dtObject;
+end;
 
 { TPpuRef }
 
 constructor TPpuRef.Create;
 begin
-  UnitIndex:=$FFFF;
-  Id:=-1;
+  UnitIndex:=InvalidUnit;
+  Id:=InvalidId;
 end;
 
 procedure TPpuRef.Write(Output: TPpuOutput; const RefName: string);
 begin
   with Output do
-    if Id < 0 then
+    if IsNull then
       WriteNull(RefName)
     else begin
       WriteObjectStart(RefName);
-      if UnitIndex <> $FFFF then
-        WriteInt('RefUnit', UnitIndex);
+      if not IsCurUnit then
+        WriteInt('Unit', UnitIndex);
       WriteInt('Id', Id);
       WriteObjectEnd;
     end;
 end;
 
+function TPpuRef.IsCurUnit: boolean;
+begin
+  Result:=UnitIndex = InvalidUnit;
+end;
+
+function TPpuRef.IsNull: boolean;
+begin
+  Result:=Id = InvalidId;
+end;
+
 { TPpuProcTypeDef }
 
 constructor TPpuProcTypeDef.Create(AParent: TPpuContainerDef);
@@ -211,16 +316,27 @@ end;
 
 { TPpuProcDef }
 
-procedure TPpuProcDef.WriteDef(Output: TPpuOutput);
-begin
-  inherited WriteDef(Output);
-  ReturnType.Write(Output, 'ReturnType');
+procedure TPpuProcDef.BeforeWriteItems(Output: TPpuOutput);
+var
+  opt: TPpuProcOption;
+begin
+  inherited BeforeWriteItems(Output);
+  if Options <> [] then begin
+    Output.WriteArrayStart('Options');
+    for opt:=Low(TPpuProcOption) to High(TPpuProcOption) do
+      if opt in Options then
+        Output.WriteStr('', ProcOptionNames[opt]);
+    Output.WriteArrayEnd;
+  end;
+
+  ReturnType.Write(Output, 'RetType');
 end;
 
 constructor TPpuProcDef.Create(AParent: TPpuContainerDef);
 begin
   inherited Create(AParent);
   DefType:=dtProc;
+  ItemsName:='Params';
   ReturnType:=TPpuRef.Create;
 end;
 
@@ -367,7 +483,7 @@ begin
       WriteStr('InterfaceCRC', hexStr(IntfCrc, 8));
     UsedUnits.WriteDef(Output);
     if Length(RefUnits) > 0 then begin
-      WriteArrayStart('RefUnits');
+      WriteArrayStart('Units');
       for i:=0 to High(RefUnits) do
         WriteStr('', RefUnits[i]);
       WriteArrayEnd;
@@ -384,10 +500,10 @@ begin
   ItemsName:='Interface';
   UsedUnits:=TPpuContainerDef.Create(nil);
   UsedUnits.FParent:=Self;
-  UsedUnits.ItemsName:='UsedUnits';
+  UsedUnits.ItemsName:='Uses';
   SourceFiles:=TPpuContainerDef.Create(nil);
   SourceFiles.FParent:=Self;
-  SourceFiles.ItemsName:='SrcFiles';
+  SourceFiles.ItemsName:='Files';
   FIndexById:=THashSet.Create(64, True, False);
 end;
 
@@ -399,11 +515,18 @@ begin
   inherited Destroy;
 end;
 
-function TPpuUnitDef.FindById(AId: integer): TPpuDef;
+function TPpuUnitDef.FindById(AId: integer; FindSym: boolean): TPpuDef;
 var
   h: PHashSetItem;
+  i: cardinal;
 begin
-  h:=FIndexById.Find(@AId, SizeOf(AId));
+  Result:=nil;
+  if AId = -1 then
+    exit;
+  i:=AId;
+  if FindSym then
+    i:=i or SymIdBit;
+  h:=FIndexById.Find(@i, SizeOf(i));
   if h <> nil then
     Result:=TPpuDef(h^.Data)
   else
@@ -433,6 +556,7 @@ var
   i: integer;
 begin
   inherited WriteDef(Output);
+  BeforeWriteItems(Output);
   if Count = 0 then
     exit;
   Output.WriteArrayStart(ItemsName);
@@ -441,6 +565,10 @@ begin
   Output.WriteArrayEnd;
 end;
 
+procedure TPpuContainerDef.BeforeWriteItems(Output: TPpuOutput);
+begin
+end;
+
 constructor TPpuContainerDef.Create(AParent: TPpuContainerDef);
 begin
   inherited Create(AParent);
@@ -471,6 +599,14 @@ begin
   Result:=DefTypeNames[DefType];
 end;
 
+function TPpuDef.GetId: cardinal;
+begin
+  if FId = InvalidId then
+    Result:=InvalidId
+  else
+    Result:=FId and not SymIdBit;
+end;
+
 function TPpuDef.GetParentUnit: TPpuUnitDef;
 var
   d: TPpuContainerDef;
@@ -484,49 +620,66 @@ begin
   Result:=FParentUnit;
 end;
 
-procedure TPpuDef.SetId(AValue: integer);
+procedure TPpuDef.SetId(AValue: cardinal);
 var
   h: PHashSetItem;
   u: TPpuUnitDef;
 begin
   if FId = AValue then Exit;
   u:=ParentUnit;
-  if (FId <> -1) and (u <> nil) then begin
+  if (FId <> InvalidId) 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;
+  if (FId <> InvalidId) and (u <> nil) then begin;
     h:=u.FIndexById.FindOrAdd(@FId, SizeOf(FId));
     h^.Data:=Self;
   end;
 end;
 
+procedure TPpuDef.SetSymId(AId: integer);
+begin
+  Id:=cardinal(AId) or SymIdBit;
+end;
+
 procedure TPpuDef.WriteDef(Output: TPpuOutput);
 begin
   with Output do begin
-    if Id >= 0 then
-      WriteInt('Id', Id);
+    if FId <> InvalidId then
+      if IsSymId(FId) then
+        WriteInt('SymId', Id)
+      else begin
+        WriteInt('Id', Id);
+        if not Ref.IsNull then
+          WriteInt('SymId', Ref.Id);
+      end;
     if FilePos.Line > 0 then begin
-      WriteObjectStart('SrcPos');
-      WriteInt('SrcFile', FilePos.FileIndex);
+      WriteObjectStart('Pos');
+      if FilePos.FileIndex > 0 then
+        WriteInt('File', FilePos.FileIndex);
       WriteInt('Line', FilePos.Line);
       WriteInt('Col', FilePos.Col);
       WriteObjectEnd;
     end;
+    if Visibility <> dvPublic then
+      WriteStr('Visibility', DefVisibilityNames[Visibility]);
   end;
 end;
 
 constructor TPpuDef.Create(AParent: TPpuContainerDef);
 begin
-  FId:=-1;
+  FId:=InvalidId;
+  Ref:=TPpuRef.Create;
+  Visibility:=dvPublic;
   if AParent <> nil then
     AParent.Add(Self);
 end;
 
 destructor TPpuDef.Destroy;
 begin
+  Ref.Free;
   inherited Destroy;
 end;