paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-21 09:42:00 +01:00
Code Issues Packages Projects Releases Wiki Activity

* ppudump: JSON output of float, string, file, variant, undefined, formal definitions.

Browse Source 
git-svn-id: trunk@24407 -
This commit is contained in:
yury 2013-05-03 12:28:19 +00:00
parent 44a0b61224
commit ad8f42cd29
2 changed files with 266 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2522,6 +2522,9 @@ var
enumdef: TPpuEnumDef absolute def; enumdef: TPpuEnumDef absolute def;
setdef: TPpuSetDef absolute def; setdef: TPpuSetDef absolute def;
orddef: TPpuOrdDef absolute def; orddef: TPpuOrdDef absolute def;
floatdef: TPpuFloatDef absolute def;
strdef: TPpuStringDef absolute def;
filedef: TPpuFileDef absolute def;
begin begin
with ppufile do with ppufile do
begin begin
@ -2670,7 +2673,8 @@ begin
orddef.OrdType:=otCurrency; orddef.OrdType:=otCurrency;
orddef.Size:=8; orddef.Size:=8;
end; end;
else WriteWarning('Invalid base type: ' + IntToStr(b)); else
WriteWarning('Invalid base type: ' + IntToStr(b));
end; end;
iexpr:=getexprint; iexpr:=getexprint;
orddef.RangeLow:=iexpr.svalue; orddef.RangeLow:=iexpr.svalue;
@ -2682,8 +2686,44 @@ begin
ibfloatdef : ibfloatdef :
begin begin
readcommondef('Float definition',defoptions); floatdef:=TPpuFloatDef.Create(ParentDef);
writeln([space,' Float type : ',getbyte]); readcommondef('Float definition',defoptions,floatdef);
write ([space,' Float type : ']);
b:=getbyte;
case b of
ftSingle:
begin
writeln('Single');
floatdef.FloatType:=pftSingle;
end;
ftDouble:
begin
writeln('Double');
floatdef.FloatType:=pftDouble;
end;
ftExtended:
begin
writeln('Extended');
floatdef.FloatType:=pftExtended;
end;
ftComp:
begin
writeln('Comp');
floatdef.FloatType:=pftComp;
end;
ftCurr:
begin
writeln('Currency');
floatdef.FloatType:=pftCurrency;
end;
ftFloat128:
begin
writeln('Float128');
floatdef.FloatType:=pftFloat128;
end;
else
WriteWarning('Invalid float type: ' + IntToStr(b));
end;
end; end;
ibarraydef : ibarraydef :
@ -2791,32 +2831,47 @@ begin
ibshortstringdef : ibshortstringdef :
begin begin
readcommondef('ShortString definition',defoptions); strdef:=TPpuStringDef.Create(ParentDef);
writeln([space,' Length : ',getbyte]); strdef.StrType:=stShort;
readcommondef('ShortString definition',defoptions,strdef);
strdef.Len:=getbyte;
writeln([space,' Length : ',strdef.Len]);
end; end;
ibwidestringdef : ibwidestringdef :
begin begin
readcommondef('WideString definition',defoptions); strdef:=TPpuStringDef.Create(ParentDef);
writeln([space,' Length : ',getaint]); strdef.StrType:=stWide;
readcommondef('WideString definition',defoptions,strdef);
strdef.Len:=getaint;
writeln([space,' Length : ',strdef.Len]);
end; end;
ibunicodestringdef : ibunicodestringdef :
begin begin
readcommondef('UnicodeString definition',defoptions); strdef:=TPpuStringDef.Create(ParentDef);
writeln([space,' Length : ',getaint]); strdef.StrType:=stUnicode;
readcommondef('UnicodeString definition',defoptions,strdef);
strdef.Len:=getaint;
writeln([space,' Length : ',strdef.Len]);
end; end;
ibansistringdef : ibansistringdef :
begin begin
readcommondef('AnsiString definition',defoptions); strdef:=TPpuStringDef.Create(ParentDef);
writeln([space,' Length : ',getaint]); strdef.StrType:=stAnsi;
readcommondef('AnsiString definition',defoptions,strdef);
strdef.Len:=getaint;
writeln([space,' Length : ',strdef.Len]);
end; end;
iblongstringdef : iblongstringdef :
begin begin
readcommondef('Longstring definition',defoptions); strdef:=TPpuStringDef.Create(ParentDef);
writeln([space,' Length : ',getaint]); strdef.StrType:=stLong;
readcommondef('Longstring definition',defoptions,strdef);
strdef.Len:=getaint;
writeln([space,' Length : ',strdef.Len]);
end; end;
ibrecorddef : ibrecorddef :
@ -2905,7 +2960,8 @@ begin
{ IIDGUID } { IIDGUID }
for j:=1to 16 do for j:=1to 16 do
getbyte; getbyte;
writeln([space,' IID String : ',getstring]); objdef.IID:=getstring;
writeln([space,' IID String : ',objdef.IID]);
end; end;
writeln([space,' Abstract methods : ',getlongint]); writeln([space,' Abstract methods : ',getlongint]);
@ -2914,7 +2970,7 @@ begin
(oo_is_classhelper in current_objectoptions) then (oo_is_classhelper in current_objectoptions) then
begin begin
write([space,' Helper parent : ']); write([space,' Helper parent : ']);
readderef(''); readderef('',objdef.HelperParent);
end; end;
l:=getlongint; l:=getlongint;
@ -2963,27 +3019,40 @@ begin
ibfiledef : ibfiledef :
begin begin
ReadCommonDef('File definition',defoptions); filedef:=TPpuFileDef.Create(ParentDef);
ReadCommonDef('File definition',defoptions,filedef);
write ([space,' Type : ']); write ([space,' Type : ']);
case getbyte of case getbyte of
0 : writeln('Text'); 0 : begin
writeln('Text');
filedef.FileType:=ftText;
end;
1 : begin 1 : begin
writeln('Typed'); writeln('Typed');
filedef.FileType:=ftTyped;
write ([space,' File of Type : ']); write ([space,' File of Type : ']);
readderef(''); readderef('',filedef.TypeRef);
end;
2 : begin
writeln('Untyped');
filedef.FileType:=ftUntyped;
end; end;
2 : writeln('Untyped');
end; end;
end; end;
ibformaldef : ibformaldef :
begin begin
readcommondef('Generic definition (void-typ)',defoptions); def:=TPpuFormalDef.Create(ParentDef);
writeln([space,' Is Typed : ',(getbyte<>0)]); readcommondef('Generic definition (void-typ)',defoptions,def);
TPpuFormalDef(def).IsTyped:=(getbyte<>0);
writeln([space,' Is Typed : ',TPpuFormalDef(def).IsTyped]);
end; end;
ibundefineddef : ibundefineddef :
readcommondef('Undefined definition (generic parameter)',defoptions); begin
def:=TPpuUndefinedDef.Create(ParentDef);
readcommondef('Undefined definition (generic parameter)',defoptions,def);
end;
ibenumdef : ibenumdef :
begin begin
@ -3036,18 +3105,21 @@ begin
ibvariantdef : ibvariantdef :
begin begin
readcommondef('Variant definition',defoptions); def:=TPpuVariantDef.Create(ParentDef);
readcommondef('Variant definition',defoptions,def);
write ([space,' Varianttype : ']); write ([space,' Varianttype : ']);
b:=getbyte; b:=getbyte;
case tvarianttype(b) of case tvarianttype(b) of
vt_normalvariant : vt_normalvariant :
writeln('Normal'); writeln('Normal');
vt_olevariant : vt_olevariant :
writeln('OLE'); begin
TPpuVariantDef(def).IsOLE:=True;
writeln('OLE');
end
else else
WriteWarning('Invalid varianttype: ' + IntToStr(b)); WriteWarning('Invalid varianttype: ' + IntToStr(b));
end; end;
end; end;
iberror : iberror :

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

@ -30,7 +30,7 @@ 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, dtPointer, dtTypeRef, dtConst, dtProcType, dtEnum, dtSet, dtClassRef, dtArray, dtPointer,
dtOrd); dtOrd, dtFloat, dtString, dtFile, dtVariant, dtUndefined, dtFormal);
TPpuDef = class; TPpuDef = class;
TPpuContainerDef = class; TPpuContainerDef = class;
@ -259,6 +259,8 @@ type
ObjType: TPpuObjType; ObjType: TPpuObjType;
Ancestor: TPpuRef; Ancestor: TPpuRef;
Options: TPpuObjOptions; Options: TPpuObjOptions;
IID: string;
HelperParent: TPpuRef;
constructor Create(AParent: TPpuContainerDef); override; constructor Create(AParent: TPpuContainerDef); override;
destructor Destroy; override; destructor Destroy; override;
function CanWrite: boolean; override; function CanWrite: boolean; override;
@ -364,13 +366,73 @@ type
constructor Create(AParent: TPpuContainerDef); override; constructor Create(AParent: TPpuContainerDef); override;
end; end;
TPpuFloatType = (pftSingle, pftDouble, pftExtended, pftComp, pftCurrency, pftFloat128);
{ TPpuFloatDef }
TPpuFloatDef = class(TPpuDef)
protected
procedure WriteDef(Output: TPpuOutput); override;
public
FloatType: TPpuFloatType;
constructor Create(AParent: TPpuContainerDef); override;
end;
TPpuStrType = (stShort, stAnsi, stWide, stUnicode, stLong);
{ TPpuStringDef }
TPpuStringDef = class(TPpuDef)
protected
procedure WriteDef(Output: TPpuOutput); override;
public
StrType: TPpuStrType;
Len: integer;
constructor Create(AParent: TPpuContainerDef); override;
end;
TPpuFileType = (ftText, ftTyped, ftUntyped);
{ TPpuFileDef }
TPpuFileDef = class(TPpuDef)
protected
procedure WriteDef(Output: TPpuOutput); override;
public
FileType: TPpuFileType;
TypeRef: TPpuRef;
constructor Create(AParent: TPpuContainerDef); override;
destructor Destroy; override;
end;
{ TPpuVariantDef }
TPpuVariantDef = class(TPpuDef)
protected
procedure WriteDef(Output: TPpuOutput); override;
public
IsOLE: boolean;
constructor Create(AParent: TPpuContainerDef); override;
end;
{ TPpuUndefinedDef }
TPpuUndefinedDef = class(TPpuDef)
public
constructor Create(AParent: TPpuContainerDef); override;
end;
{ TPpuFormalDef }
TPpuFormalDef = class(TPpuDef)
protected
procedure WriteDef(Output: TPpuOutput); override;
public
IsTyped: boolean;
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', 'ptr', 'ord'); 'type', 'const', 'proctype', 'enum', 'set', 'classref', 'array', 'ptr',
'ord', 'float', 'string', 'file', 'variant', 'undefined', 'formal');
ProcOptionNames: array[TPpuProcOption] of string = ProcOptionNames: array[TPpuProcOption] of string =
('procedure', 'function', 'constructor', 'destructor', 'operator', ('procedure', 'function', 'constructor', 'destructor', 'operator',
@ -397,6 +459,15 @@ const
OrdTypeNames: array[TPpuOrdType] of string = OrdTypeNames: array[TPpuOrdType] of string =
('void', 'uint', 'sint', 'pasbool', 'bool', 'char', 'currency'); ('void', 'uint', 'sint', 'pasbool', 'bool', 'char', 'currency');
FloatTypeNames: array[TPpuFloatType] of string =
('single', 'double', 'extended', 'comp', 'currency', 'float128');
StrTypeNames: array[TPpuStrType] of string =
('short', 'ansi', 'wide', 'unicode', 'long');
FileTypeNames: array[TPpuFileType] of string =
('text', 'typed', 'untyped');
SymIdBit = $80000000; SymIdBit = $80000000;
InvalidId = cardinal(-1); InvalidId = cardinal(-1);
InvalidUnit = word(-1); InvalidUnit = word(-1);
@ -406,6 +477,96 @@ begin
Result:=Id and SymIdBit <> 0; Result:=Id and SymIdBit <> 0;
end; end;
{ TPpuUndefinedDef }
constructor TPpuUndefinedDef.Create(AParent: TPpuContainerDef);
begin
inherited Create(AParent);
DefType:=dtUndefined;
end;
{ TPpuFormalDef }
procedure TPpuFormalDef.WriteDef(Output: TPpuOutput);
begin
inherited WriteDef(Output);
Output.WriteBool('IsTyped', IsTyped);
end;
constructor TPpuFormalDef.Create(AParent: TPpuContainerDef);
begin
inherited Create(AParent);
DefType:=dtFormal;
end;
{ TPpuVariantDef }
procedure TPpuVariantDef.WriteDef(Output: TPpuOutput);
begin
inherited WriteDef(Output);
if IsOLE then
Output.WriteBool('OleVariant', True);
end;
constructor TPpuVariantDef.Create(AParent: TPpuContainerDef);
begin
inherited Create(AParent);
DefType:=dtVariant;
end;
{ TPpuFileDef }
procedure TPpuFileDef.WriteDef(Output: TPpuOutput);
begin
inherited WriteDef(Output);
Output.WriteStr('FileType', FileTypeNames[FileType]);
if FileType = ftTyped then
TypeRef.Write(Output, 'TypeRef');
end;
constructor TPpuFileDef.Create(AParent: TPpuContainerDef);
begin
inherited Create(AParent);
DefType:=dtFile;
TypeRef:=TPpuRef.Create;
end;
destructor TPpuFileDef.Destroy;
begin
TypeRef.Free;
inherited Destroy;
end;
{ TPpuStringDef }
procedure TPpuStringDef.WriteDef(Output: TPpuOutput);
begin
inherited WriteDef(Output);
Output.WriteStr('StrType', StrTypeNames[StrType]);
if Len >= 0 then
Output.WriteInt('Len', Len);
end;
constructor TPpuStringDef.Create(AParent: TPpuContainerDef);
begin
inherited Create(AParent);
DefType:=dtString;
end;
{ TPpuFloatDef }
procedure TPpuFloatDef.WriteDef(Output: TPpuOutput);
begin
inherited WriteDef(Output);
Output.WriteStr('FloatType', FloatTypeNames[FloatType]);
end;
constructor TPpuFloatDef.Create(AParent: TPpuContainerDef);
begin
inherited Create(AParent);
DefType:=dtFloat;
end;
{ TPpuOrdDef } { TPpuOrdDef }
procedure TPpuOrdDef.WriteDef(Output: TPpuOutput); procedure TPpuOrdDef.WriteDef(Output: TPpuOutput);
@ -775,6 +936,10 @@ begin
Output.WriteStr('', ObjOptionNames[opt]); Output.WriteStr('', ObjOptionNames[opt]);
Output.WriteArrayEnd; Output.WriteArrayEnd;
end; end;
if IID <> '' then
Output.WriteStr('IID', IID);
if not HelperParent.IsNull then
HelperParent.Write(Output, 'HelperParent');
end; end;
constructor TPpuObjectDef.Create(AParent: TPpuContainerDef); constructor TPpuObjectDef.Create(AParent: TPpuContainerDef);
@ -784,11 +949,13 @@ begin
ItemsName:='Fields'; ItemsName:='Fields';
ObjType:=otUnknown; ObjType:=otUnknown;
Ancestor:=TPpuRef.Create; Ancestor:=TPpuRef.Create;
HelperParent:=TPpuRef.Create;
end; end;
destructor TPpuObjectDef.Destroy; destructor TPpuObjectDef.Destroy;
begin begin
Ancestor.Free; Ancestor.Free;
HelperParent.Free;
inherited Destroy; inherited Destroy;
end; end;