paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 02:59:33 +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 case VType of
vtInteger: system.write(VInteger); vtInteger: system.write(VInteger);
vtInt64: system.write(VInt64^); vtInt64: system.write(VInt64^);
vtQWord: system.write(VQWord^);
vtString: system.write(VString^); vtString: system.write(VString^);
vtAnsiString: system.write(ansistring(VAnsiString)); vtAnsiString: system.write(ansistring(VAnsiString));
vtPChar: system.write(VPChar); vtPChar: system.write(VPChar);
@ -2503,11 +2504,13 @@ var
calloption : tproccalloption; calloption : tproccalloption;
procoptions : tprocoptions; procoptions : tprocoptions;
defoptions: tdefoptions; defoptions: tdefoptions;
iexpr: Tconstexprint;
def: TPpuDef; def: TPpuDef;
objdef: TPpuObjectDef absolute def; objdef: TPpuObjectDef absolute def;
arrdef: TPpuArrayDef absolute def; arrdef: TPpuArrayDef absolute def;
enumdef: TPpuEnumDef absolute def; enumdef: TPpuEnumDef absolute def;
setdef: TPpuSetDef absolute def; setdef: TPpuSetDef absolute def;
orddef: TPpuOrdDef absolute def;
begin begin
with ppufile do with ppufile do
begin begin
@ -2522,38 +2525,148 @@ begin
ibpointerdef : ibpointerdef :
begin begin
readcommondef('Pointer definition',defoptions); def:=TPpuPointerDef.Create(ParentDef);
readcommondef('Pointer definition',defoptions,def);
write ([space,' Pointed Type : ']); write ([space,' Pointed Type : ']);
readderef(''); readderef('',TPpuPointerDef(def).Ptr);
writeln([space,' Is Far : ',(getbyte<>0)]); writeln([space,' Is Far : ',(getbyte<>0)]);
writeln([space,' Has Pointer Math : ',(getbyte<>0)]); writeln([space,' Has Pointer Math : ',(getbyte<>0)]);
end; end;
iborddef : iborddef :
begin begin
readcommondef('Ordinal definition',defoptions); orddef:=TPpuOrdDef.Create(ParentDef);
readcommondef('Ordinal definition',defoptions,orddef);
write ([space,' Base type : ']); write ([space,' Base type : ']);
b:=getbyte; b:=getbyte;
case tordtype(b) of case tordtype(b) of
uvoid : writeln('uvoid'); uvoid:
u8bit : writeln('u8bit'); begin
u16bit : writeln('u16bit'); writeln('uvoid');
u32bit : writeln('s32bit'); orddef.OrdType:=otVoid;
u64bit : writeln('u64bit'); end;
s8bit : writeln('s8bit'); u8bit:
s16bit : writeln('s16bit'); begin
s32bit : writeln('s32bit'); writeln('u8bit');
s64bit : writeln('s64bit'); orddef.OrdType:=otUInt;
bool8bit : writeln('bool8bit'); orddef.Size:=1;
bool16bit : writeln('bool16bit'); end;
bool32bit : writeln('bool32bit'); u16bit:
bool64bit : writeln('bool64bit'); begin
uchar : writeln('uchar'); writeln('u16bit');
uwidechar : writeln('uwidechar'); orddef.OrdType:=otUInt;
scurrency : writeln('ucurrency'); 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]); else writeln(['!! Warning: Invalid base type ',b]);
end; 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; end;
ibfloatdef : ibfloatdef :

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

@ -42,7 +42,7 @@ type
procedure WriteArrayStart(const AName: string); override; procedure WriteArrayStart(const AName: string); override;
procedure WriteArrayEnd; override; procedure WriteArrayEnd; override;
procedure WriteStr(const AName, AValue: string); 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 WriteFloat(const AName: string; AValue: extended); override;
procedure WriteBool(const AName: string; AValue: boolean); override; procedure WriteBool(const AName: string; AValue: boolean); override;
procedure WriteNull(const AName: string); override; procedure WriteNull(const AName: string); override;
@ -159,9 +159,12 @@ begin
WriteAttr(AName, JsonStr(AValue)); WriteAttr(AName, JsonStr(AValue));
end; end;
procedure TPpuJsonOutput.WriteInt(const AName: string; AValue: Int64); procedure TPpuJsonOutput.WriteInt(const AName: string; AValue: Int64; Signed: boolean);
begin begin
WriteAttr(AName, IntToStr(AValue)); if Signed then
WriteAttr(AName, IntToStr(AValue))
else
WriteAttr(AName, IntToStr(QWord(AValue)));
end; end;
procedure TPpuJsonOutput.WriteFloat(const AName: string; AValue: extended); 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 type
TPpuDefType = (dtNone, dtUnit, dtObject, dtRecord, dtProc, dtField, dtProp, dtParam, dtVar, 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; TPpuDef = class;
TPpuContainerDef = class; TPpuContainerDef = class;
@ -51,7 +52,7 @@ type
procedure WriteArrayStart(const AName: string); virtual; procedure WriteArrayStart(const AName: string); virtual;
procedure WriteArrayEnd; virtual; procedure WriteArrayEnd; virtual;
procedure WriteStr(const AName, AValue: string); 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 WriteFloat(const AName: string; AValue: extended); virtual;
procedure WriteBool(const AName: string; AValue: boolean); virtual; procedure WriteBool(const AName: string; AValue: boolean); virtual;
procedure WriteNull(const AName: string); virtual; procedure WriteNull(const AName: string); virtual;
@ -204,7 +205,7 @@ type
constructor Create(AParent: TPpuContainerDef); override; constructor Create(AParent: TPpuContainerDef); override;
end; end;
TPpuConstType = (ctInt, ctFloat, ctStr, ctSet, ctPtr); TPpuConstType = (ctUnknown, ctInt, ctFloat, ctStr, ctSet, ctPtr);
{ TPpuConstDef } { TPpuConstDef }
TPpuConstDef = class(TPpuDef) TPpuConstDef = class(TPpuDef)
@ -219,6 +220,7 @@ type
VSet: array[0..31] of byte; VSet: array[0..31] of byte;
constructor Create(AParent: TPpuContainerDef); override; constructor Create(AParent: TPpuContainerDef); override;
destructor Destroy; override; destructor Destroy; override;
function CanWrite: boolean; override;
end; end;
{ TPpuVarDef } { TPpuVarDef }
@ -339,12 +341,36 @@ type
destructor Destroy; override; destructor Destroy; override;
end; 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 implementation
const const
DefTypeNames: array[TPpuDefType] of string = DefTypeNames: array[TPpuDefType] of string =
('', 'unit', 'obj', 'rec', 'proc', 'field', 'prop', 'param', 'var', ('', '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 = ProcOptionNames: array[TPpuProcOption] of string =
('procedure', 'function', 'constructor', 'destructor', 'operator', ('procedure', 'function', 'constructor', 'destructor', 'operator',
@ -366,7 +392,10 @@ const
('dynamic'); ('dynamic');
ConstTypeNames: array[TPpuConstType] of string = 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; SymIdBit = $80000000;
InvalidId = cardinal(-1); InvalidId = cardinal(-1);
@ -377,6 +406,49 @@ begin
Result:=Id and SymIdBit <> 0; Result:=Id and SymIdBit <> 0;
end; 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 } { TPpuSetDef }
procedure TPpuSetDef.WriteDef(Output: TPpuOutput); procedure TPpuSetDef.WriteDef(Output: TPpuOutput);
@ -453,7 +525,10 @@ begin
if VInt = 0 then if VInt = 0 then
WriteNull(s) WriteNull(s)
else 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: ctSet:
begin begin
ss:=''; ss:='';
@ -472,6 +547,7 @@ begin
inherited Create(AParent); inherited Create(AParent);
DefType:=dtConst; DefType:=dtConst;
TypeRef:=TPpuRef.Create; TypeRef:=TPpuRef.Create;
ConstType:=ctUnknown;
end; end;
destructor TPpuConstDef.Destroy; destructor TPpuConstDef.Destroy;
@ -480,6 +556,11 @@ begin
inherited Destroy; inherited Destroy;
end; end;
function TPpuConstDef.CanWrite: boolean;
begin
Result:=inherited CanWrite and (ConstType <> ctUnknown);
end;
{ TPpuArrayDef } { TPpuArrayDef }
procedure TPpuArrayDef.WriteDef(Output: TPpuOutput); procedure TPpuArrayDef.WriteDef(Output: TPpuOutput);
@ -851,9 +932,12 @@ procedure TPpuOutput.WriteStr(const AName, AValue: string);
begin begin
end; end;
procedure TPpuOutput.WriteInt(const AName: string; AValue: Int64); procedure TPpuOutput.WriteInt(const AName: string; AValue: Int64; Signed: boolean);
begin begin
WriteStr(AName, IntToStr(AValue)); if Signed then
WriteStr(AName, IntToStr(AValue))
else
WriteStr(AName, IntToStr(QWord(AValue)));
end; end;
procedure TPpuOutput.WriteFloat(const AName: string; AValue: extended); procedure TPpuOutput.WriteFloat(const AName: string; AValue: extended);