paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-18 10:59:44 +02:00
Code Issues Packages Projects Releases Wiki Activity

* ppudump: JSON output of pointers and ordinal definitions.

Browse Source 
git-svn-id: trunk@24405 -
This commit is contained in:
yury 2013-05-03 11:04:18 +00:00
parent 4527fe8fa2
commit 3a8ed11e23
3 changed files with 231 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

153
compiler/utils/ppuutils/ppudump.pp
View File

@ -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 :

9
compiler/utils/ppuutils/ppujson.pp
View File

@ -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);

100
compiler/utils/ppuutils/ppuout.pp
View File

@ -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);