* ppudump: JSON output of properties and global vars.

git-svn-id: trunk@24331 -

compiler/utils/ppuutils/ppudump.pp

@@ -981,7 +981,7 @@ begin
 end;
 
 
-procedure readpropaccesslist(const s:string);
+procedure readpropaccesslist(const s:string; Ref: TPpuRef = nil);
 { type tsltype is in symconst unit }
 const
   slstr : array[tsltype] of string[12] = (
@@ -996,7 +996,7 @@ const
 var
   sl : tsltype;
 begin
-  readderef('');
+  readderef('',Ref);
   repeat
     sl:=tsltype(ppufile.getbyte);
     if sl=sl_none then
@@ -1006,7 +1006,13 @@ begin
       sl_call,
       sl_load,
       sl_subscript :
-        readderef('');
+        if (Ref <> nil) and (Ref.IsNull) then
+         begin
+           readderef('',Ref);
+           Ref.IsSymId:=True;
+         end
+        else
+          readderef('');
       sl_absolutetype,
       sl_typeconv :
         readderef('');
@@ -2321,7 +2327,8 @@ begin
 
          ibstaticvarsym :
            begin
-             readabstractvarsym('Global Variable symbol ',varoptions);
+             def:=TPpuVarDef.Create(ParentDef);
+             readabstractvarsym('Global Variable symbol ',varoptions,TPpuVarDef(def));
              write  ([space,' DefaultConst : ']);
              readderef('');
              if (vo_has_mangledname in varoptions) then
@@ -2390,7 +2397,8 @@ begin
 
          ibpropertysym :
            begin
-             readcommonsym('Property ');
+             def:=TPpuPropDef.Create(ParentDef);
+             readcommonsym('Property ',def);
              propoptions:=readpropertyoptions;
              if ppo_overrides in propoptions then
                begin
@@ -2398,7 +2406,7 @@ begin
                  readderef('');
                end;
              write  ([space,'    Prop Type : ']);
-             readderef('');
+             readderef('',TPpuPropDef(def).PropType);
              writeln([space,'        Index : ',getlongint]);
              writeln([space,'      Default : ',getlongint]);
              write  ([space,'   Index Type : ']);
@@ -2406,15 +2414,15 @@ begin
              { palt_none }
              readpropaccesslist('');
              write  ([space,'   Readaccess : ']);
-             readpropaccesslist(space+'         Sym: ');
+             readpropaccesslist(space+'         Sym: ',TPpuPropDef(def).Getter);
              write  ([space,'  Writeaccess : ']);
-             readpropaccesslist(space+'         Sym: ');
+             readpropaccesslist(space+'         Sym: ',TPpuPropDef(def).Setter);
              write  ([space,' Storedaccess : ']);
              readpropaccesslist(space+'         Sym: ');
              if [ppo_hasparameters,ppo_overrides]*propoptions=[ppo_hasparameters] then
                begin
                  space:='    '+space;
-                 readsymtable('parast');
+                 readsymtable('parast',TPpuPropDef(def));
                  delete(space,1,4);
                end;
            end;

compiler/utils/ppuutils/ppuout.pp

@@ -68,11 +68,18 @@ type
 
   { TPpuRef }
   TPpuRef = class
+  private
+    FId: cardinal;
+    function GetId: cardinal;
+    function GetIsSymId: boolean;
+    procedure SetId(AValue: cardinal);
+    procedure SetIsSymId(AValue: boolean);
   public
     UnitIndex: word;
-    Id: cardinal;
     constructor Create;
     procedure Write(Output: TPpuOutput; const RefName: string);
+    property Id: cardinal read GetId write SetId;
+    property IsSymId: boolean read GetIsSymId write SetIsSymId;
     function IsCurUnit: boolean; inline;
     function IsNull: boolean; inline;
   end;
@@ -242,6 +249,18 @@ type
     constructor Create(AParent: TPpuContainerDef); override;
   end;
 
+  { TPpuPropDef }
+  TPpuPropDef = class(TPpuContainerDef)
+  protected
+    procedure BeforeWriteItems(Output: TPpuOutput); override;
+  public
+    PropType: TPpuRef;
+    Getter, Setter: TPpuRef;
+    constructor Create(AParent: TPpuContainerDef); override;
+    destructor Destroy; override;
+  end;
+
+
 implementation
 
 const
@@ -274,12 +293,40 @@ begin
   Result:=Id and SymIdBit <> 0;
 end;
 
+{ TPpuPropDef }
+
+procedure TPpuPropDef.BeforeWriteItems(Output: TPpuOutput);
+begin
+  inherited BeforeWriteItems(Output);
+  PropType.Write(Output, 'PropType');
+  Getter.Write(Output, 'Getter');
+  Setter.Write(Output, 'Setter');
+end;
+
+constructor TPpuPropDef.Create(AParent: TPpuContainerDef);
+begin
+  inherited Create(AParent);
+  DefType:=dtProp;
+  ItemsName:='Params';
+  PropType:=TPpuRef.Create;
+  Getter:=TPpuRef.Create;
+  Setter:=TPpuRef.Create;
+end;
+
+destructor TPpuPropDef.Destroy;
+begin
+  Getter.Free;
+  Setter.Free;
+  PropType.Free;
+  inherited Destroy;
+end;
+
 { TPpuTypeRef }
 
 procedure TPpuTypeRef.WriteDef(Output: TPpuOutput);
 begin
   inherited WriteDef(Output);
-  Ref.Write(Output, 'TypeRef');
+  Ref.Write(Output, 'Ref');
 end;
 
 constructor TPpuTypeRef.Create(AParent: TPpuContainerDef);
@@ -378,10 +425,39 @@ end;
 
 { TPpuRef }
 
+function TPpuRef.GetId: cardinal;
+begin
+  if FId = InvalidId then
+    Result:=InvalidId
+  else
+    Result:=FId and not SymIdBit;
+end;
+
+function TPpuRef.GetIsSymId: boolean;
+begin
+  Result:=FId and SymIdBit <> 0;
+end;
+
+procedure TPpuRef.SetId(AValue: cardinal);
+begin
+  if (FId = InvalidId) or (AValue = InvalidId) then
+    FId:=AValue
+  else
+    FId:=AValue or (FId and SymIdBit);
+end;
+
+procedure TPpuRef.SetIsSymId(AValue: boolean);
+begin
+  if AValue then
+    FId:=FId or SymIdBit
+  else
+    FId:=FId and not SymIdBit;
+end;
+
 constructor TPpuRef.Create;
 begin
   UnitIndex:=InvalidUnit;
-  Id:=InvalidId;
+  FId:=InvalidId;
 end;
 
 procedure TPpuRef.Write(Output: TPpuOutput; const RefName: string);
@@ -393,7 +469,10 @@ begin
       WriteObjectStart(RefName);
       if not IsCurUnit then
         WriteInt('Unit', UnitIndex);
-      WriteInt('Id', Id);
+      if IsSymId then
+        WriteInt('SymId', Id)
+      else
+        WriteInt('Id', Id);
       WriteObjectEnd;
     end;
 end;