* ppudump: JSON output of pointers and ordinal definitions.

git-svn-id: trunk@24405 -

compiler/utils/ppuutils/ppudump.pp

@@ -299,6 +299,7 @@ begin
       case VType of
         vtInteger: system.write(VInteger);
         vtInt64: system.write(VInt64^);
+        vtQWord: system.write(VQWord^);
         vtString: system.write(VString^);
         vtAnsiString: system.write(ansistring(VAnsiString));
         vtPChar: system.write(VPChar);
@@ -2503,11 +2504,13 @@ var
   calloption : tproccalloption;
   procoptions : tprocoptions;
   defoptions: tdefoptions;
+  iexpr: Tconstexprint;
   def: TPpuDef;
   objdef: TPpuObjectDef absolute def;
   arrdef: TPpuArrayDef absolute def;
   enumdef: TPpuEnumDef absolute def;
   setdef: TPpuSetDef absolute def;
+  orddef: TPpuOrdDef absolute def;
 begin
   with ppufile do
    begin
@@ -2522,38 +2525,148 @@ begin
 
          ibpointerdef :
            begin
-             readcommondef('Pointer definition',defoptions);
+             def:=TPpuPointerDef.Create(ParentDef);
+             readcommondef('Pointer definition',defoptions,def);
              write  ([space,'     Pointed Type : ']);
-             readderef('');
+             readderef('',TPpuPointerDef(def).Ptr);
              writeln([space,'           Is Far : ',(getbyte<>0)]);
              writeln([space,' Has Pointer Math : ',(getbyte<>0)]);
            end;
 
          iborddef :
            begin
-             readcommondef('Ordinal definition',defoptions);
+             orddef:=TPpuOrdDef.Create(ParentDef);
+             readcommondef('Ordinal definition',defoptions,orddef);
              write  ([space,'        Base type : ']);
              b:=getbyte;
              case tordtype(b) of
-               uvoid     : writeln('uvoid');
-               u8bit     : writeln('u8bit');
-               u16bit    : writeln('u16bit');
-               u32bit    : writeln('s32bit');
-               u64bit    : writeln('u64bit');
-               s8bit     : writeln('s8bit');
-               s16bit    : writeln('s16bit');
-               s32bit    : writeln('s32bit');
-               s64bit    : writeln('s64bit');
-               bool8bit  : writeln('bool8bit');
-               bool16bit : writeln('bool16bit');
-               bool32bit : writeln('bool32bit');
-               bool64bit : writeln('bool64bit');
-               uchar     : writeln('uchar');
-               uwidechar : writeln('uwidechar');
-               scurrency : writeln('ucurrency');
+               uvoid:
+                 begin
+                   writeln('uvoid');
+                   orddef.OrdType:=otVoid;
+                 end;
+               u8bit:
+                 begin
+                   writeln('u8bit');
+                   orddef.OrdType:=otUInt;
+                   orddef.Size:=1;
+                 end;
+               u16bit:
+                 begin
+                   writeln('u16bit');
+                   orddef.OrdType:=otUInt;
+                   orddef.Size:=2;
+                 end;
+               u32bit:
+                 begin
+                   writeln('u32bit');
+                   orddef.OrdType:=otUInt;
+                   orddef.Size:=4;
+                 end;
+               u64bit:
+                 begin
+                   writeln('u64bit');
+                   orddef.OrdType:=otUInt;
+                   orddef.Size:=8;
+                 end;
+               s8bit:
+                 begin
+                   writeln('s8bit');
+                   orddef.OrdType:=otSInt;
+                   orddef.Size:=1;
+                 end;
+               s16bit:
+                 begin
+                   writeln('s16bit');
+                   orddef.OrdType:=otSInt;
+                   orddef.Size:=2;
+                 end;
+               s32bit:
+                 begin
+                   writeln('s32bit');
+                   orddef.OrdType:=otSInt;
+                   orddef.Size:=4;
+                 end;
+               s64bit:
+                 begin
+                   writeln('s64bit');
+                   orddef.OrdType:=otSInt;
+                   orddef.Size:=8;
+                 end;
+               pasbool8:
+                 begin
+                   writeln('pasbool8');
+                   orddef.OrdType:=otPasBool;
+                   orddef.Size:=1;
+                 end;
+               pasbool16:
+                 begin
+                   writeln('pasbool16');
+                   orddef.OrdType:=otPasBool;
+                   orddef.Size:=2;
+                 end;
+               pasbool32:
+                 begin
+                   writeln('pasbool32');
+                   orddef.OrdType:=otPasBool;
+                   orddef.Size:=4;
+                 end;
+               pasbool64:
+                 begin
+                   writeln('pasbool64');
+                   orddef.OrdType:=otPasBool;
+                   orddef.Size:=8;
+                 end;
+               bool8bit:
+                 begin
+                   writeln('bool8bit');
+                   orddef.OrdType:=otBool;
+                   orddef.Size:=1;
+                 end;
+               bool16bit:
+                 begin
+                   writeln('bool16bit');
+                   orddef.OrdType:=otBool;
+                   orddef.Size:=2;
+                 end;
+               bool32bit:
+                 begin
+                   writeln('bool32bit');
+                   orddef.OrdType:=otBool;
+                   orddef.Size:=4;
+                 end;
+               bool64bit:
+                 begin
+                   writeln('bool64bit');
+                   orddef.OrdType:=otBool;
+                   orddef.Size:=8;
+                 end;
+               uchar:
+                 begin
+                   writeln('uchar');
+                   orddef.OrdType:=otChar;
+                   orddef.Size:=1;
+                 end;
+               uwidechar:
+                 begin
+                   writeln('uwidechar');
+                   orddef.OrdType:=otChar;
+                   orddef.Size:=2;
+                 end;
+               scurrency:
+                 begin
+                   writeln('scurrency');
+                   orddef.OrdType:=otCurrency;
+                   orddef.Size:=8;
+                 end;
                else        writeln(['!! Warning: Invalid base type ',b]);
              end;
-             writeln([space,'            Range : ',constexp.tostr(getexprint),' to ',constexp.tostr(getexprint)]);
+             iexpr:=getexprint;
+             orddef.RangeLow:=iexpr.svalue;
+             write([space,'            Range : ',constexp.tostr(iexpr)]);
+             iexpr:=getexprint;
+             orddef.RangeHigh:=iexpr.svalue;
+             writeln([' to ',constexp.tostr(iexpr)]);
            end;
 
          ibfloatdef :

compiler/utils/ppuutils/ppujson.pp

@@ -42,7 +42,7 @@ type
     procedure WriteArrayStart(const AName: string); override;
     procedure WriteArrayEnd; override;
     procedure WriteStr(const AName, AValue: string); override;
-    procedure WriteInt(const AName: string; AValue: Int64); override;
+    procedure WriteInt(const AName: string; AValue: Int64; Signed: boolean); override;
     procedure WriteFloat(const AName: string; AValue: extended); override;
     procedure WriteBool(const AName: string; AValue: boolean); override;
     procedure WriteNull(const AName: string); override;
@@ -159,9 +159,12 @@ begin
   WriteAttr(AName, JsonStr(AValue));
 end;
 
-procedure TPpuJsonOutput.WriteInt(const AName: string; AValue: Int64);
+procedure TPpuJsonOutput.WriteInt(const AName: string; AValue: Int64; Signed: boolean);
 begin
-  WriteAttr(AName, IntToStr(AValue));
+  if Signed then
+    WriteAttr(AName, IntToStr(AValue))
+  else
+    WriteAttr(AName, IntToStr(QWord(AValue)));
 end;
 
 procedure TPpuJsonOutput.WriteFloat(const AName: string; AValue: extended);

compiler/utils/ppuutils/ppuout.pp

@@ -29,7 +29,8 @@ uses SysUtils, cclasses, Classes;
 
 type
   TPpuDefType = (dtNone, dtUnit, dtObject, dtRecord, dtProc, dtField, dtProp, dtParam, dtVar,
-                 dtTypeRef, dtConst, dtProcType, dtEnum, dtSet, dtClassRef, dtArray);
+                 dtTypeRef, dtConst, dtProcType, dtEnum, dtSet, dtClassRef, dtArray, dtPointer,
+                 dtOrd);
 
   TPpuDef = class;
   TPpuContainerDef = class;
@@ -51,7 +52,7 @@ type
     procedure WriteArrayStart(const AName: string); virtual;
     procedure WriteArrayEnd; virtual;
     procedure WriteStr(const AName, AValue: string); virtual;
-    procedure WriteInt(const AName: string; AValue: Int64); virtual;
+    procedure WriteInt(const AName: string; AValue: Int64; Signed: boolean = True); virtual;
     procedure WriteFloat(const AName: string; AValue: extended); virtual;
     procedure WriteBool(const AName: string; AValue: boolean); virtual;
     procedure WriteNull(const AName: string); virtual;
@@ -204,7 +205,7 @@ type
     constructor Create(AParent: TPpuContainerDef); override;
   end;
 
-  TPpuConstType = (ctInt, ctFloat, ctStr, ctSet, ctPtr);
+  TPpuConstType = (ctUnknown, ctInt, ctFloat, ctStr, ctSet, ctPtr);
 
   { TPpuConstDef }
   TPpuConstDef = class(TPpuDef)
@@ -219,6 +220,7 @@ type
     VSet: array[0..31] of byte;
     constructor Create(AParent: TPpuContainerDef); override;
     destructor Destroy; override;
+    function CanWrite: boolean; override;
   end;
 
   { TPpuVarDef }
@@ -339,12 +341,36 @@ type
     destructor Destroy; override;
   end;
 
+  { TPpuPointerDef }
+  TPpuPointerDef = class(TPpuDef)
+  protected
+    procedure WriteDef(Output: TPpuOutput); override;
+  public
+    Ptr: TPpuRef;
+    constructor Create(AParent: TPpuContainerDef); override;
+    destructor Destroy; override;
+  end;
+
+  TPpuOrdType = (otVoid, otUInt, otSInt, otPasBool, otBool, otChar, otCurrency);
+
+  { TPpuOrdDef }
+  TPpuOrdDef = class(TPpuDef)
+  protected
+    procedure WriteDef(Output: TPpuOutput); override;
+  public
+    OrdType: TPpuOrdType;
+    Size: byte;
+    RangeLow, RangeHigh: Int64;
+    constructor Create(AParent: TPpuContainerDef); override;
+  end;
+
+
 implementation
 
 const
   DefTypeNames: array[TPpuDefType] of string =
     ('', 'unit', 'obj', 'rec', 'proc', 'field', 'prop', 'param', 'var',
-     'type', 'const', 'proctype', 'enum', 'set', 'classref', 'array');
+     'type', 'const', 'proctype', 'enum', 'set', 'classref', 'array', 'ptr', 'ord');
 
   ProcOptionNames: array[TPpuProcOption] of string =
     ('procedure', 'function', 'constructor', 'destructor', 'operator',
@@ -366,7 +392,10 @@ const
     ('dynamic');
 
   ConstTypeNames: array[TPpuConstType] of string =
-    ('int', 'float', 'string', 'set', 'pointer');
+    ('', 'int', 'float', 'string', 'set', 'pointer');
+
+  OrdTypeNames: array[TPpuOrdType] of string =
+    ('void', 'uint', 'sint', 'pasbool', 'bool', 'char', 'currency');
 
   SymIdBit = $80000000;
   InvalidId = cardinal(-1);
@@ -377,6 +406,49 @@ begin
   Result:=Id and SymIdBit <> 0;
 end;
 
+{ TPpuOrdDef }
+
+procedure TPpuOrdDef.WriteDef(Output: TPpuOutput);
+var
+  Signed: boolean;
+begin
+  inherited WriteDef(Output);
+  with Output do begin
+    WriteStr('OrdType', OrdTypeNames[OrdType]);
+    WriteInt('Size', Size);
+    Signed:=OrdType in [otSInt, otCurrency, otBool];
+    WriteInt('Low', RangeLow, Signed);
+    WriteInt('High', RangeHigh, Signed);
+  end;
+end;
+
+constructor TPpuOrdDef.Create(AParent: TPpuContainerDef);
+begin
+  inherited Create(AParent);
+  DefType:=dtOrd;
+end;
+
+{ TPpuPointerDef }
+
+procedure TPpuPointerDef.WriteDef(Output: TPpuOutput);
+begin
+  inherited WriteDef(Output);
+  Ptr.Write(Output, 'Ptr');
+end;
+
+constructor TPpuPointerDef.Create(AParent: TPpuContainerDef);
+begin
+  inherited Create(AParent);
+  DefType:=dtPointer;
+  Ptr:=TPpuRef.Create;
+end;
+
+destructor TPpuPointerDef.Destroy;
+begin
+  Ptr.Free;
+  inherited Destroy;
+end;
+
 { TPpuSetDef }
 
 procedure TPpuSetDef.WriteDef(Output: TPpuOutput);
@@ -453,7 +525,10 @@ begin
         if VInt = 0 then
           WriteNull(s)
         else
-          WriteStr(s, hexStr(QWord(VInt), SizeOf(pointer)*2));
+          if QWord(VInt) > $FFFFFFFF then
+            WriteStr(s, hexStr(QWord(VInt), 8))
+          else
+            WriteStr(s, hexStr(QWord(VInt), 16));
       ctSet:
         begin
           ss:='';
@@ -472,6 +547,7 @@ begin
   inherited Create(AParent);
   DefType:=dtConst;
   TypeRef:=TPpuRef.Create;
+  ConstType:=ctUnknown;
 end;
 
 destructor TPpuConstDef.Destroy;
@@ -480,6 +556,11 @@ begin
   inherited Destroy;
 end;
 
+function TPpuConstDef.CanWrite: boolean;
+begin
+  Result:=inherited CanWrite and (ConstType <> ctUnknown);
+end;
+
 { TPpuArrayDef }
 
 procedure TPpuArrayDef.WriteDef(Output: TPpuOutput);
@@ -851,9 +932,12 @@ procedure TPpuOutput.WriteStr(const AName, AValue: string);
 begin
 end;
 
-procedure TPpuOutput.WriteInt(const AName: string; AValue: Int64);
+procedure TPpuOutput.WriteInt(const AName: string; AValue: Int64; Signed: boolean);
 begin
-  WriteStr(AName, IntToStr(AValue));
+  if Signed then
+    WriteStr(AName, IntToStr(AValue))
+  else
+    WriteStr(AName, IntToStr(QWord(AValue)));
 end;
 
 procedure TPpuOutput.WriteFloat(const AName: string; AValue: extended);