From 3a8ed11e2324a710afc4b6c958da9401bca89345 Mon Sep 17 00:00:00 2001 From: yury Date: Fri, 3 May 2013 11:04:18 +0000 Subject: [PATCH] * ppudump: JSON output of pointers and ordinal definitions. git-svn-id: trunk@24405 - --- compiler/utils/ppuutils/ppudump.pp | 153 +++++++++++++++++++++++++---- compiler/utils/ppuutils/ppujson.pp | 9 +- compiler/utils/ppuutils/ppuout.pp | 100 +++++++++++++++++-- 3 files changed, 231 insertions(+), 31 deletions(-) diff --git a/compiler/utils/ppuutils/ppudump.pp b/compiler/utils/ppuutils/ppudump.pp index 4fd3d87599..a1ac344f07 100644 --- a/compiler/utils/ppuutils/ppudump.pp +++ b/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 : diff --git a/compiler/utils/ppuutils/ppujson.pp b/compiler/utils/ppuutils/ppujson.pp index 4058af8e67..5682f1ad7e 100644 --- a/compiler/utils/ppuutils/ppujson.pp +++ b/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); diff --git a/compiler/utils/ppuutils/ppuout.pp b/compiler/utils/ppuutils/ppuout.pp index f187dd4d27..ffd8b4dbe7 100644 --- a/compiler/utils/ppuutils/ppuout.pp +++ b/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);