* ppudump: JSON output of constants, records, arrays, class refs.

git-svn-id: trunk@24333 -

compiler/utils/ppuutils/ppudump.pp

@@ -1194,7 +1194,7 @@ begin
   writeln;
 end;
 
-procedure readsymoptions(space : string);
+procedure readsymoptions(space : string; Def: TPpuDef = nil);
 type
   tsymopt=record
     mask : tsymoption;
@@ -1226,6 +1226,9 @@ begin
   ppufile.getsmallset(symoptions);
   if symoptions<>[] then
    begin
+     if Def <> nil then
+       if sp_internal in symoptions then
+         Def.Visibility:=dvHidden;
      first:=true;
      for i:=1to symopts do
       if (symopt[i].mask in symoptions) then
@@ -1275,7 +1278,7 @@ begin
   write  ([space,'   Visibility : ']);
   readvisibility(Def);
   write  ([space,'   SymOptions : ']);
-  readsymoptions(space+'   ');
+  readsymoptions(space+'   ',Def);
 end;
 
 
@@ -1874,7 +1877,7 @@ begin
 end;
 
 
-procedure readarraydefoptions;
+procedure readarraydefoptions(ArrayDef: TPpuArrayDef);
 { type tarraydefoption is in unit symconst }
 type
   tsymopt=record
@@ -1899,6 +1902,7 @@ begin
   ppufile.getsmallset(symoptions);
   if symoptions<>[] then
    begin
+     if ado_IsDynamicArray in symoptions then Include(ArrayDef.Options, aoDynamic);
      first:=true;
      for i:=1 to high(symopt) do
       if (symopt[i].mask in symoptions) then
@@ -2067,7 +2071,6 @@ procedure readsymbols(const s:string; ParentDef: TPpuContainerDef = nil);
         begin
           Result.Name:=symdef.Name;
           Result.FilePos:=symdef.FilePos;
-          Result.Visibility:=symdef.Visibility;
         end
        else
          Result:=nil;
@@ -2089,7 +2092,7 @@ var
   ch : dword;
   startnewline : boolean;
   i,j,len : longint;
-  prettyname : ansistring;
+  prettyname, ss : ansistring;
   guid : tguid;
   realvalue : ppureal;
   doublevalue : double;
@@ -2099,7 +2102,9 @@ var
   pw : pcompilerwidestring;
   varoptions : tvaroptions;
   propoptions : tpropertyoptions;
+  iexp: Tconstexprint;
   def: TPpuDef;
+  constdef: TPpuConstDef absolute def;
 begin
   with ppufile do
    begin
@@ -2163,14 +2168,18 @@ begin
 
          ibconstsym :
            begin
-             readcommonsym('Constant symbol ');
+             constdef:=TPpuConstDef.Create(ParentDef);
+             readcommonsym('Constant symbol ',constdef);
              b:=getbyte;
              case tconsttyp(b) of
                constord :
                  begin
                    write  ([space,'  OrdinalType : ']);
-                   readderef('');
-                   writeln([space,'        Value : ',constexp.tostr(getexprint)]);
+                   readderef('',constdef.TypeRef);
+                   iexp:=getexprint;
+                   constdef.ConstType:=ctInt;
+                   constdef.VInt:=iexp.svalue;
+                   writeln([space,'        Value : ',constexp.tostr(iexp)]);
                  end;
                constpointer :
                  begin
@@ -2187,32 +2196,40 @@ begin
                    (pc+len)^:= #0;
                    writeln([space,'       Length : ',len]);
                    writeln([space,'        Value : "',pc,'"']);
+                   constdef.ConstType:=ctStr;
+                   SetString(constdef.VStr, pc, len);
                    freemem(pc,len+1);
                  end;
                constreal :
                  begin
+                   constdef.ConstType:=ctFloat;
                    write  ([space,'     RealType : ']);
-                   readderef('');
+                   readderef('',constdef.TypeRef);
                    write([space,'        Value : ']);
                    if entryleft=sizeof(ppureal) then
                      begin
                        realvalue:=getrealsize(sizeof(ppureal));
+                       constdef.VFloat:=realvalue;
                        writeln([realvalue]);
                      end
                    else if entryleft=sizeof(double) then
                      begin
                        doublevalue:=getrealsize(sizeof(double));
+                       constdef.VFloat:=doublevalue;
                        writeln([doublevalue]);
                      end
                    else if entryleft=sizeof(single) then
                      begin
                        singlevalue:=getrealsize(sizeof(single));
+                       constdef.VFloat:=singlevalue;
                        writeln([singlevalue]);
                      end
                    else if entryleft=10 then
                      begin
                        getdata(extended,entryleft);
-                       writeln(Real80bitToStr(extended));
+                       ss:=Real80bitToStr(extended);
+                       constdef.VFloat:=StrToFloat(ss);
+                       writeln(ss);
                      end
                    else
                      begin
@@ -2299,7 +2316,8 @@ begin
 
          ibabsolutevarsym :
            begin
-             readabstractvarsym('Absolute variable symbol ',varoptions);
+             def:=TPpuVarDef.Create(ParentDef);
+             readabstractvarsym('Absolute variable symbol ',varoptions,TPpuVarDef(def));
              Write ([space,' Relocated to ']);
              b:=getbyte;
              case absolutetyp(b) of
@@ -2351,7 +2369,7 @@ begin
              def:=TPpuParamDef.Create(ParentDef);
              readabstractvarsym('Parameter Variable symbol ',varoptions,TPpuVarDef(def));
              write  ([space,' DefaultConst : ']);
-             readderef('');
+             readderef('',TPpuParamDef(def).DefaultValue);
              writeln([space,'       ParaNr : ',getword]);
              writeln([space,'        Univ  : ',boolean(getbyte)]);
              writeln([space,'     VarState : ',getbyte]);
@@ -2471,9 +2489,9 @@ var
   calloption : tproccalloption;
   procoptions : tprocoptions;
   defoptions: tdefoptions;
-  procdef: TPpuProcDef;
-  ptypedef: TPpuProcTypeDef;
-  objdef: TPpuObjectDef;
+  def: TPpuDef;
+  objdef: TPpuObjectDef absolute def;
+  arrdef: TPpuArrayDef absolute def;
 begin
   with ppufile do
    begin
@@ -2529,22 +2547,25 @@ begin
 
          ibarraydef :
            begin
-             readcommondef('Array definition',defoptions);
+             arrdef:=TPpuArrayDef.Create(ParentDef);
+             readcommondef('Array definition',defoptions,arrdef);
              write  ([space,'     Element type : ']);
-             readderef('');
+             readderef('',arrdef.ElType);
              write  ([space,'       Range Type : ']);
-             readderef('');
-             writeln([space,'            Range : ',getaint,' to ',getaint]);
+             readderef('',arrdef.RangeType);
+             arrdef.RangeLow:=getaint;
+             arrdef.RangeHigh:=getaint;
+             writeln([space,'            Range : ',arrdef.RangeLow,' to ',arrdef.RangeHigh]);
              write  ([space,'          Options : ']);
-             readarraydefoptions;
+             readarraydefoptions(arrdef);
              readsymtable('symbols');
            end;
 
          ibprocdef :
            begin
-             procdef:=TPpuProcDef.Create(ParentDef);
-             readcommondef('Procedure definition',defoptions,procdef);
-             read_abstract_proc_def(calloption,procoptions,procdef);
+             def:=TPpuProcDef.Create(ParentDef);
+             readcommondef('Procedure definition',defoptions,def);
+             read_abstract_proc_def(calloption,procoptions,TPpuProcDef(def));
              if (po_has_mangledname in procoptions) then
 {$ifdef symansistr}
                writeln([space,'     Mangled name : ',getansistring]);
@@ -2556,11 +2577,11 @@ begin
              write  ([space,'            Class : ']);
              readderef('');
              write  ([space,'          Procsym : ']);
-             readderef('', procdef.Ref);
+             readderef('', def.Ref);
              write  ([space,'         File Pos : ']);
-             readposinfo(procdef);
+             readposinfo(def);
              write  ([space,'       Visibility : ']);
-             readvisibility(procdef);
+             readvisibility(def);
              write  ([space,'       SymOptions : ']);
              readsymoptions(space+'       ');
              write  ([space,'   Synthetic kind : ',Synthetic2Str(ppufile.getbyte)]);
@@ -2604,7 +2625,7 @@ begin
                HasMoreInfos;
              space:='    '+space;
              { parast }
-             readsymtable('parast', procdef);
+             readsymtable('parast', TPpuProcDef(def));
              { localst }
              if (po_has_inlininginfo in procoptions) then
                 readsymtable('localst');
@@ -2615,15 +2636,15 @@ begin
 
          ibprocvardef :
            begin
-             ptypedef:=TPpuProcTypeDef.Create(ParentDef);
-             readcommondef('Procedural type (ProcVar) definition',defoptions,ptypedef);
-             read_abstract_proc_def(calloption,procoptions, ptypedef);
+             def:=TPpuProcTypeDef.Create(ParentDef);
+             readcommondef('Procedural type (ProcVar) definition',defoptions,def);
+             read_abstract_proc_def(calloption,procoptions, TPpuProcDef(def));
              writeln([space,'   Symtable level :',ppufile.getbyte]);
              if not EndOfEntry then
                HasMoreInfos;
              space:='    '+space;
              { parast }
-             readsymtable('parast');
+             readsymtable('parast',TPpuProcDef(def));
              delete(space,1,4);
            end;
 
@@ -2659,15 +2680,18 @@ begin
 
          ibrecorddef :
            begin
-             readcommondef('Record definition',defoptions);
-             writeln([space,'   Name of Record : ',getstring]);
+             def:=TPpuRecordDef.Create(ParentDef);
+             readcommondef('Record definition',defoptions, def);
+             def.Name:=getstring;
+             writeln([space,'   Name of Record : ',def.Name]);
              writeln([space,'   Import lib/pkg : ',getstring]);
              write  ([space,'          Options : ']);
-             readobjectdefoptions;
+             readobjectdefoptions(TPpuRecordDef(def));
              if (df_copied_def in defoptions) then
                begin
+                 Include(TPpuRecordDef(def).Options, ooCopied);
                  write([space,'      Copied from : ']);
-                 readderef('');
+                 readderef('',TPpuRecordDef(def).Ancestor);
                end
              else
                begin
@@ -2685,7 +2709,7 @@ begin
                begin
                  space:='    '+space;
                  readrecsymtableoptions;
-                 readsymtable('fields');
+                 readsymtable('fields',TPpuRecordDef(def));
                  Delete(space,1,4);
                end;
            end;
@@ -2779,8 +2803,9 @@ begin
 
              if df_copied_def in current_defoptions then
                begin
+                 Include(objdef.Options, ooCopied);
                  writeln('  Copy of def: ');
-                 readderef('');
+                 readderef('',objdef.Ancestor);
                end;
 
              if not EndOfEntry then
@@ -2844,9 +2869,10 @@ begin
 
          ibclassrefdef :
            begin
-             readcommondef('Class reference definition',defoptions);
+             def:=TPpuClassRefDef.Create(ParentDef);
+             readcommondef('Class reference definition',defoptions,def);
              write  ([space,'    Pointed Type : ']);
-             readderef('');
+             readderef('',TPpuClassRefDef(def).ClassRef);
            end;
 
          ibsetdef :

compiler/utils/ppuutils/ppuout.pp

@@ -29,7 +29,7 @@ uses SysUtils, cclasses, Classes;
 
 type
   TPpuDefType = (dtNone, dtUnit, dtObject, dtRecord, dtProc, dtField, dtProp, dtParam, dtVar,
-                 dtTypeRef, dtConst, dtProcType, dtEnum, dtSet);
+                 dtTypeRef, dtConst, dtProcType, dtEnum, dtSet, dtClassRef, dtArray);
 
   TPpuDef = class;
   TPpuContainerDef = class;
@@ -89,7 +89,7 @@ type
     Line, Col: integer;
   end;
 
-  TPpuDefVisibility = (dvPublic, dvPublished, dvProtected, dvPrivate);
+  TPpuDefVisibility = (dvPublic, dvPublished, dvProtected, dvPrivate, dvHidden);
 
   { TPpuDef }
 
@@ -117,7 +117,7 @@ type
 
     constructor Create(AParent: TPpuContainerDef); virtual; reintroduce;
     destructor Destroy; override;
-    procedure Write(Output: TPpuOutput);
+    procedure Write(Output: TPpuOutput; const AttrName: string = '');
     function CanWrite: boolean; virtual;
     procedure SetSymId(AId: integer);
     property Parent: TPpuContainerDef read FParent write SetParent;
@@ -204,6 +204,22 @@ type
     constructor Create(AParent: TPpuContainerDef); override;
   end;
 
+  TPpuConstType = (ctInt, ctFloat, ctStr);
+
+  { TPpuConstDef }
+  TPpuConstDef = class(TPpuDef)
+  protected
+    procedure WriteDef(Output: TPpuOutput); override;
+  public
+    ConstType: TPpuConstType;
+    TypeRef: TPpuRef;
+    VInt: Int64;
+    VFloat: extended;
+    VStr: string;
+    constructor Create(AParent: TPpuContainerDef); override;
+    destructor Destroy; override;
+  end;
+
   { TPpuVarDef }
   TPpuVarDef = class(TPpuDef)
   protected
@@ -222,12 +238,14 @@ type
     procedure WriteDef(Output: TPpuOutput); override;
   public
     Spez: TPpuParamSpez;
+    DefaultValue: TPpuRef;
     constructor Create(AParent: TPpuContainerDef); override;
+    destructor Destroy; override;
     function CanWrite: boolean; override;
   end;
 
   TPpuObjType = (otUnknown, otClass, otObject, otInterface, otHelper);
-  TPpuObjOption = (ooIsAbstract);
+  TPpuObjOption = (ooIsAbstract, ooCopied);
   TPpuObjOptions = set of TPpuObjOption;
 
   { TPpuObjectDef }
@@ -260,20 +278,55 @@ type
     destructor Destroy; override;
   end;
 
+  { TPpuRecordDef }
+  TPpuRecordDef = class(TPpuObjectDef)
+  protected
+    procedure BeforeWriteItems(Output: TPpuOutput); override;
+  public
+    constructor Create(AParent: TPpuContainerDef); override;
+    function CanWrite: boolean; override;
+  end;
+
+  { TPpuClassRefDef }
+  TPpuClassRefDef = class(TPpuDef)
+  protected
+    procedure WriteDef(Output: TPpuOutput); override;
+  public
+    ClassRef: TPpuRef;
+    constructor Create(AParent: TPpuContainerDef); override;
+    destructor Destroy; override;
+  end;
+
+  TPpuArrayOption = (aoDynamic);
+  TPpuArrayOptions = set of TPpuArrayOption;
+
+  { TPpuArrayDef }
+  TPpuArrayDef = class(TPpuDef)
+  protected
+    procedure WriteDef(Output: TPpuOutput); override;
+  public
+    ElType: TPpuRef;
+    RangeType: TPpuRef;
+    RangeLow, RangeHigh: Int64;
+    Options: TPpuArrayOptions;
+    constructor Create(AParent: TPpuContainerDef); override;
+    destructor Destroy; override;
+    function CanWrite: boolean; override;
+  end;
 
 implementation
 
 const
   DefTypeNames: array[TPpuDefType] of string =
     ('', 'unit', 'obj', 'rec', 'proc', 'field', 'prop', 'param', 'var',
-     'type', 'const', 'proctype', 'enum', 'set');
+     'type', 'const', 'proctype', 'enum', 'set', 'classref', 'array');
 
   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');
+    ('public', 'published', 'protected', 'private', '');
 
   ParamSpezNames: array[TPpuParamSpez] of string =
     ('value', 'var', 'out', 'const', 'constref', '');
@@ -282,7 +335,13 @@ const
     ('', 'class', 'object', 'interface', 'helper');
 
   ObjOptionNames: array[TPpuObjOption] of string =
-    ('abstract');
+    ('abstract','copied');
+
+  ArrayOptionNames: array[TPpuArrayOption] of string =
+    ('dynamic');
+
+  ConstTypeNames: array[TPpuConstType] of string =
+    ('int', 'float', 'string');
 
   SymIdBit = $80000000;
   InvalidId = cardinal(-1);
@@ -293,6 +352,123 @@ begin
   Result:=Id and SymIdBit <> 0;
 end;
 
+{ TPpuConstDef }
+
+procedure TPpuConstDef.WriteDef(Output: TPpuOutput);
+var
+  s: string;
+begin
+  inherited WriteDef(Output);
+  with Output do begin
+    WriteStr('ValType', ConstTypeNames[ConstType]);
+    s:='Value';
+    case ConstType of
+      ctInt:
+        WriteInt(s, VInt);
+      ctFloat:
+        WriteFloat(s, VFloat);
+      ctStr:
+        WriteStr(s, VStr);
+    end;
+  end;
+  if not TypeRef.IsNull then
+    TypeRef.Write(Output, 'TypeRef');
+end;
+
+constructor TPpuConstDef.Create(AParent: TPpuContainerDef);
+begin
+  inherited Create(AParent);
+  DefType:=dtConst;
+  TypeRef:=TPpuRef.Create;
+end;
+
+destructor TPpuConstDef.Destroy;
+begin
+  TypeRef.Free;
+  inherited Destroy;
+end;
+
+{ TPpuArrayDef }
+
+procedure TPpuArrayDef.WriteDef(Output: TPpuOutput);
+var
+  opt: TPpuArrayOption;
+begin
+  inherited WriteDef(Output);
+  if Options <> [] then begin
+    Output.WriteArrayStart('Options');
+    for opt:=Low(opt) to High(opt) do
+      if opt in Options then
+        Output.WriteStr('', ArrayOptionNames[opt]);
+    Output.WriteArrayEnd;
+  end;
+  ElType.Write(Output, 'ElType');
+  RangeType.Write(Output, 'RangeType');;
+  Output.WriteInt('Low', RangeLow);
+  Output.WriteInt('High', RangeHigh);
+end;
+
+constructor TPpuArrayDef.Create(AParent: TPpuContainerDef);
+begin
+  inherited Create(AParent);
+  DefType:=dtArray;
+  ElType:=TPpuRef.Create;
+  RangeType:=TPpuRef.Create;
+end;
+
+destructor TPpuArrayDef.Destroy;
+begin
+  ElType.Free;
+  RangeType.Free;
+  inherited Destroy;
+end;
+
+function TPpuArrayDef.CanWrite: boolean;
+begin
+  Result:=inherited CanWrite and (Name <> '');
+end;
+
+{ TPpuClassRefDef }
+
+procedure TPpuClassRefDef.WriteDef(Output: TPpuOutput);
+begin
+  inherited WriteDef(Output);
+  ClassRef.Write(Output, 'Ref');
+end;
+
+constructor TPpuClassRefDef.Create(AParent: TPpuContainerDef);
+begin
+  inherited Create(AParent);
+  DefType:=dtClassRef;
+  ClassRef:=TPpuRef.Create;
+end;
+
+destructor TPpuClassRefDef.Destroy;
+begin
+  ClassRef.Free;
+  inherited Destroy;
+end;
+
+{ TPpuRecordDef }
+
+procedure TPpuRecordDef.BeforeWriteItems(Output: TPpuOutput);
+begin
+  inherited BeforeWriteItems(Output);
+  if ooCopied in Options then
+    Ancestor.Write(Output, 'CopyFrom');
+end;
+
+constructor TPpuRecordDef.Create(AParent: TPpuContainerDef);
+begin
+  inherited Create(AParent);
+  DefType:=dtRecord;
+end;
+
+function TPpuRecordDef.CanWrite: boolean;
+begin
+  Result:=True;
+end;
+
 { TPpuPropDef }
 
 procedure TPpuPropDef.BeforeWriteItems(Output: TPpuOutput);
@@ -346,10 +522,26 @@ end;
 { TPpuParamDef }
 
 procedure TPpuParamDef.WriteDef(Output: TPpuOutput);
+var
+  i, j: integer;
+  d: TPpuDef;
 begin
   inherited WriteDef(Output);
   if Spez <> psValue then
     Output.WriteStr('Spez', ParamSpezNames[Spez]);
+  if not DefaultValue.IsNull then begin
+    j:=DefaultValue.Id;
+    for i:=0 to Parent.Count - 1 do begin
+      d:=Parent[i];
+      if (d.DefType = dtConst) and (d.Id = j) then begin
+        d.Visibility:=dvPublic;
+        d.Name:='';
+        d.Write(Output, 'Default');
+        d.Visibility:=dvHidden;
+        break;
+      end;
+    end;
+  end;
 end;
 
 constructor TPpuParamDef.Create(AParent: TPpuContainerDef);
@@ -357,11 +549,18 @@ begin
   inherited Create(AParent);
   DefType:=dtParam;
   Spez:=psValue;
+  DefaultValue:=TPpuRef.Create;
+end;
+
+destructor TPpuParamDef.Destroy;
+begin
+  DefaultValue.Free;
+  inherited Destroy;
 end;
 
 function TPpuParamDef.CanWrite: boolean;
 begin
-  Result:=Spez <> psHidden;
+  Result:=inherited CanWrite and (Spez <> psHidden);
 end;
 
 { TPpuVarDef }
@@ -392,6 +591,10 @@ var
   opt: TPpuObjOption;
 begin
   inherited BeforeWriteItems(Output);
+  if ObjType <> otUnknown then begin
+    Output.WriteStr('ObjType', ObjTypeNames[ObjType]);
+    Ancestor.Write(Output, 'Ancestor');
+  end;
   if Options <> [] then begin
     Output.WriteArrayStart('Options');
     for opt:=Low(opt) to High(opt) do
@@ -399,8 +602,6 @@ begin
         Output.WriteStr('', ObjOptionNames[opt]);
     Output.WriteArrayEnd;
   end;
-  Output.WriteStr('ObjType', ObjTypeNames[ObjType]);
-  Ancestor.Write(Output, 'Ancestor');
 end;
 
 constructor TPpuObjectDef.Create(AParent: TPpuContainerDef);
@@ -420,7 +621,7 @@ end;
 
 function TPpuObjectDef.CanWrite: boolean;
 begin
-  Result:=ObjType <> otUnknown;
+  Result:=inherited CanWrite and (ObjType <> otUnknown);
 end;
 
 { TPpuRef }
@@ -879,12 +1080,12 @@ begin
   inherited Destroy;
 end;
 
-procedure TPpuDef.Write(Output: TPpuOutput);
+procedure TPpuDef.Write(Output: TPpuOutput; const AttrName: string);
 begin
   if not CanWrite then
     exit;
   if Parent <> nil then
-    Output.WriteObjectStart('', Self);
+    Output.WriteObjectStart(AttrName, Self);
   WriteDef(Output);
   if Parent <> nil then
     Output.WriteObjectEnd(Self);
@@ -892,7 +1093,7 @@ end;
 
 function TPpuDef.CanWrite: boolean;
 begin
-  Result:=True;
+  Result:=Visibility <> dvHidden;
 end;
 
 end.