mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-12-06 09:27:30 +01:00
* pas2jni: use stable JSON output from ppudump.
git-svn-id: trunk@24510 -
This commit is contained in:
yury
parent
6211de8b87
commit
45895f26e0
@ -37,7 +37,7 @@ type
|
||||
private
|
||||
FOnCheckItem: TOnCheckItem;
|
||||
function FindUnit(const AName: string): string;
|
||||
procedure ReadUnit(const AName: string; Lines: TStrings);
|
||||
function ReadUnit(const AName: string): string;
|
||||
function InternalParse(const AUnitName: string): TUnitDef;
|
||||
public
|
||||
SearchPath: TStringList;
|
||||
@ -54,7 +54,7 @@ var
|
||||
|
||||
implementation
|
||||
|
||||
uses process, pipes;
|
||||
uses process, pipes, fpjson, jsonparser;
|
||||
|
||||
type
|
||||
TCharSet = set of char;
|
||||
@ -166,11 +166,25 @@ begin
|
||||
raise Exception.CreateFmt('Unable to find PPU file for unit "%s".', [AName]);
|
||||
end;
|
||||
|
||||
procedure TPPUParser.ReadUnit(const AName: string; Lines: TStrings);
|
||||
function TPPUParser.ReadUnit(const AName: string): string;
|
||||
|
||||
procedure _ReadOutput(o: TInputPipeStream; var s: string);
|
||||
var
|
||||
i, j: integer;
|
||||
begin
|
||||
with o do
|
||||
while NumBytesAvailable > 0 do begin
|
||||
i:=NumBytesAvailable;
|
||||
j:=Length(s);
|
||||
SetLength(s, j + i);
|
||||
ReadBuffer(s[j + 1], i);
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
p: TProcess;
|
||||
s, un: ansistring;
|
||||
i, j: integer;
|
||||
s, un, err: ansistring;
|
||||
ec: integer;
|
||||
begin
|
||||
un:=FindUnit(AName);
|
||||
p:=TProcess.Create(nil);
|
||||
@ -186,8 +200,9 @@ begin
|
||||
end;
|
||||
end;
|
||||
p.Executable:=ppudumpprog;
|
||||
p.Parameters.Add('-Fj');
|
||||
p.Parameters.Add(un);
|
||||
p.Options:=[poUsePipes, poNoConsole, poStderrToOutPut];
|
||||
p.Options:=[poUsePipes, poNoConsole];
|
||||
p.ShowWindow:=swoHIDE;
|
||||
p.StartupOptions:=[suoUseShowWindow];
|
||||
try
|
||||
@ -196,86 +211,52 @@ begin
|
||||
raise Exception.CreateFmt('Unable to run "%s".'+LineEnding+'%s', [p.Executable, Exception(ExceptObject).Message]);
|
||||
end;
|
||||
s:='';
|
||||
err:='';
|
||||
repeat
|
||||
with p.Output do
|
||||
while NumBytesAvailable > 0 do begin
|
||||
i:=NumBytesAvailable;
|
||||
j:=Length(s);
|
||||
SetLength(s, j + i);
|
||||
ReadBuffer(s[j + 1], i);
|
||||
end;
|
||||
_ReadOutput(p.Output, s);
|
||||
_ReadOutput(p.Stderr, err);
|
||||
until not p.Running;
|
||||
if p.ExitStatus <> 0 then begin
|
||||
if Length(s) > 300 then
|
||||
s:='';
|
||||
raise Exception.CreateFmt('Error reading contents of unit "%s" using "%s".'+LineEnding+'Error code: %d'+LineEnding+'%s', [un, ppudumpprog, p.ExitStatus, s]);
|
||||
ec:=p.ExitStatus;
|
||||
if Copy(s, 1, 1) <> '[' then begin
|
||||
ec:=-1;
|
||||
err:='Output of ppudump is not in JSON format.' + LineEnding + 'Probably old version of ppudump has been used.';
|
||||
end;
|
||||
if ec <> 0 then begin
|
||||
if err = '' then
|
||||
if Length(s) < 300 then
|
||||
err:=s;
|
||||
raise Exception.CreateFmt('Error reading contents of unit "%s" using "%s".'+LineEnding+'Error code: %d'+LineEnding+'%s', [un, ppudumpprog, ec, err]);
|
||||
end;
|
||||
finally
|
||||
p.Free;
|
||||
end;
|
||||
Lines.Text:=s;
|
||||
Result:=s;
|
||||
{$ifopt D+}
|
||||
// Lines.SaveToFile(AName + '-dump.txt');
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
const
|
||||
LInc = 4;
|
||||
SDefId = '** Definition Id ';
|
||||
SSymId = '** Symbol Id ';
|
||||
|
||||
function TPPUParser.InternalParse(const AUnitName: string): TUnitDef;
|
||||
var
|
||||
FLines: TStringList;
|
||||
junit: TJSONObject;
|
||||
jp: TJSONParser;
|
||||
deref: array of TUnitDef;
|
||||
CurUnit: TUnitDef;
|
||||
CurDef: TDef;
|
||||
level, skiplevel: integer;
|
||||
IsSystemUnit: boolean;
|
||||
AMainUnit: boolean;
|
||||
CurObjName: string;
|
||||
|
||||
function _ThisLevel(const s: string): boolean;
|
||||
function _GetRef(Ref: TJSONObject; ExpectedClass: TDefClass = nil): TDef;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
Result:=True;
|
||||
if (level = 1) or (Length(s) < level - LInc) then
|
||||
exit;
|
||||
if s[1] = '-' then begin
|
||||
Result:=False;
|
||||
exit;
|
||||
end;
|
||||
i:=level;
|
||||
repeat
|
||||
Dec(i, LInc);
|
||||
if Copy(s, i, 3) = '** ' then begin
|
||||
Result:=False;
|
||||
exit;
|
||||
end;
|
||||
until i = 1;
|
||||
end;
|
||||
|
||||
function _GetDef(const Path: string; ExpectedClass: TDefClass = nil): TDef;
|
||||
var
|
||||
s, ss: string;
|
||||
i, j: integer;
|
||||
j: integer;
|
||||
u: TUnitDef;
|
||||
begin
|
||||
Result:=nil;
|
||||
if Ref = nil then
|
||||
exit;
|
||||
u:=CurUnit;
|
||||
s:=Trim(Path);
|
||||
if Copy(s, 1, 1) = '(' then begin
|
||||
i:=Pos(') ', s);
|
||||
if i > 0 then
|
||||
Delete(s, 1, i + 1);
|
||||
end;
|
||||
i:=1;
|
||||
while True do begin
|
||||
ss:=Trim(ExtractWord(i, s, [',']));
|
||||
if ss = '' then
|
||||
break;
|
||||
if Pos('Unit', ss) = 1 then begin
|
||||
j:=StrToInt(Copy(ss, 6, MaxInt));
|
||||
j:=Ref.Get('Unit', -1);
|
||||
if j >= 0 then begin
|
||||
u:=deref[j];
|
||||
if u.DefType = dtNone then begin
|
||||
// Reading unit
|
||||
@ -291,10 +272,9 @@ var
|
||||
deref[j].Free;
|
||||
deref[j]:=u;
|
||||
end;
|
||||
end
|
||||
else
|
||||
if Pos('DefId', ss) = 1 then begin
|
||||
j:=StrToInt(Copy(ss, 7, MaxInt));
|
||||
end;
|
||||
|
||||
j:=Ref.Integers['Id'];
|
||||
Result:=u.FindDef(j);
|
||||
if Result = nil then begin
|
||||
if ExpectedClass <> nil then
|
||||
@ -303,147 +283,220 @@ var
|
||||
Result:=TDef.Create(u, dtNone);
|
||||
Result.DefId:=j;
|
||||
end;
|
||||
break;
|
||||
end;
|
||||
Inc(i);
|
||||
end;
|
||||
|
||||
if (ExpectedClass <> nil) and (Result <> nil) then
|
||||
if (Result.DefType <> dtNone) and not (Result is ExpectedClass) then
|
||||
raise Exception.CreateFmt('Unexpected class. Expected: %s, got: %s', [ExpectedClass.ClassName, Result.ClassName]);
|
||||
end;
|
||||
|
||||
function _ReadSym(var idx: integer; ParentDef: TDef): TDef;
|
||||
procedure _ReadDefs(CurDef: TDef; jobj: TJSONObject; const ItemsName: string);
|
||||
var
|
||||
s, ss, name: string;
|
||||
id: integer;
|
||||
i, j: integer;
|
||||
jt, s: string;
|
||||
d: TDef;
|
||||
it: TJSONObject;
|
||||
jarr, arr: TJSONArray;
|
||||
begin
|
||||
Result:=nil;
|
||||
// symvol id
|
||||
s:=Trim(FLines[idx]);
|
||||
id:=StrToInt(ExtractWord(4, s, [' ']));
|
||||
Inc(idx);
|
||||
s:=Trim(FLines[idx]);
|
||||
if Pos('Property', s) = 1 then begin
|
||||
name:=Trim(Copy(s, 10, MaxInt));
|
||||
Result:=TVarDef.Create(nil, dtProp);
|
||||
TVarDef(Result).VarOpt:=[];
|
||||
jarr:=jobj.Get(ItemsName, TJSONArray(nil));
|
||||
if jarr = nil then
|
||||
exit;
|
||||
with jarr do
|
||||
for i:=0 to Count - 1 do begin
|
||||
it:=Objects[i];
|
||||
CurObjName:=it.Get('Name', '');
|
||||
jt:=it.Strings['Type'];
|
||||
if jt = 'obj' then begin
|
||||
if it.Strings['ObjType'] <> 'class' then
|
||||
continue;
|
||||
d:=TClassDef.Create(CurDef, dtClass);
|
||||
end
|
||||
else begin
|
||||
i:=Pos('symbol', s);
|
||||
if i = 0 then
|
||||
exit;
|
||||
name:=Trim(Copy(s, i + 7, MaxInt));
|
||||
if Copy(name, 1, 1) = '$' then
|
||||
exit;
|
||||
else
|
||||
if jt = 'rec' then begin
|
||||
if IsSystemUnit and (CompareText(it.Strings['Name'], 'tguid') = 0) then begin
|
||||
d:=TTypeDef.Create(CurDef, dtType);
|
||||
TTypeDef(d).BasicType:=btGuid;
|
||||
end
|
||||
else
|
||||
d:=TRecordDef.Create(CurDef, dtRecord);
|
||||
end
|
||||
else
|
||||
if jt = 'proc' then
|
||||
d:=TProcDef.Create(CurDef, dtProc)
|
||||
else
|
||||
if jt = 'proctype' then begin
|
||||
d:=TProcDef.Create(CurDef, dtProcType);
|
||||
TProcDef(d).ProcType:=ptProcedure;
|
||||
end
|
||||
else
|
||||
if jt = 'param' then begin
|
||||
d:=TVarDef.Create(CurDef, dtParam);
|
||||
TVarDef(d).VarOpt:=[voRead];
|
||||
end
|
||||
else
|
||||
if jt = 'prop' then begin
|
||||
d:=TVarDef.Create(CurDef, dtProp);
|
||||
TVarDef(d).VarOpt:=[];
|
||||
end
|
||||
else
|
||||
if jt = 'field' then
|
||||
d:=TVarDef.Create(CurDef, dtField)
|
||||
else
|
||||
if jt = 'var' then
|
||||
d:=TVarDef.Create(CurDef, dtVar)
|
||||
else
|
||||
if jt = 'ord' then begin
|
||||
d:=TTypeDef.Create(CurDef, dtType);
|
||||
with TTypeDef(d) do begin
|
||||
s:=it.Strings['OrdType'];
|
||||
j:=it.Get('Size', 0);
|
||||
if s = 'void' then
|
||||
BasicType:=btVoid
|
||||
else
|
||||
if s = 'uint' then begin
|
||||
case j of
|
||||
1: BasicType:=btByte;
|
||||
2: BasicType:=btWord;
|
||||
4: BasicType:=btLongWord;
|
||||
else BasicType:=btInt64;
|
||||
end;
|
||||
end
|
||||
else
|
||||
if s = 'sint' then begin
|
||||
case j of
|
||||
1: BasicType:=btShortInt;
|
||||
2: BasicType:=btSmallInt;
|
||||
4: BasicType:=btLongInt;
|
||||
else BasicType:=btInt64;
|
||||
end;
|
||||
end
|
||||
else
|
||||
if (s = 'pasbool') or (s = 'bool') then
|
||||
BasicType:=btBoolean
|
||||
else
|
||||
if s = 'char' then begin
|
||||
if j = 1 then
|
||||
BasicType:=btChar
|
||||
else
|
||||
BasicType:=btWideChar;
|
||||
end
|
||||
else
|
||||
if s = 'currency' then
|
||||
BasicType:=btDouble;
|
||||
end;
|
||||
end
|
||||
else
|
||||
if jt = 'float' then begin
|
||||
d:=TTypeDef.Create(CurDef, dtType);
|
||||
with TTypeDef(d) do
|
||||
if it.Strings['FloatType'] = 'single' then
|
||||
BasicType:=btSingle
|
||||
else
|
||||
BasicType:=btDouble;
|
||||
end
|
||||
else
|
||||
if jt = 'string' then begin
|
||||
d:=TTypeDef.Create(CurDef, dtType);
|
||||
s:=it.Strings['StrType'];
|
||||
with TTypeDef(d) do
|
||||
if (s = 'wide') or (s = 'unicode') or (s = 'long') then
|
||||
BasicType:=btWideString
|
||||
else
|
||||
BasicType:=btString;
|
||||
CurObjName:=s + 'string';
|
||||
end
|
||||
else
|
||||
if jt = 'enum' then begin
|
||||
d:=TTypeDef.Create(CurDef, dtEnum);
|
||||
TTypeDef(d).BasicType:=btEnum;
|
||||
end
|
||||
else
|
||||
if jt = 'set' then
|
||||
d:=TSetDef.Create(CurDef, dtSet)
|
||||
else
|
||||
if jt = 'ptr' then begin
|
||||
d:=TTypeDef.Create(CurDef, dtType);
|
||||
TTypeDef(d).BasicType:=btPointer;
|
||||
end
|
||||
else
|
||||
if jt = 'const' then
|
||||
d:=TConstDef.Create(CurDef, dtConst)
|
||||
else
|
||||
continue;
|
||||
|
||||
s:=LowerCase(Trim(Copy(s, 1, i - 1)));
|
||||
if s = 'field variable' then
|
||||
Result:=TVarDef.Create(nil, dtField)
|
||||
else
|
||||
if s = 'global variable' then
|
||||
Result:=TVarDef.Create(nil, dtVar)
|
||||
else
|
||||
if s = 'parameter variable' then begin
|
||||
Result:=TVarDef.Create(nil, dtParam);
|
||||
TVarDef(Result).VarOpt:=[voRead];
|
||||
end
|
||||
else
|
||||
if s = 'enumeration' then begin
|
||||
if ParentDef = CurUnit then
|
||||
exit;
|
||||
Result:=TConstDef.Create(nil, dtConst);
|
||||
TConstDef(Result).VarType:=ParentDef;
|
||||
end
|
||||
else
|
||||
if s = 'constant' then begin
|
||||
Result:=TConstDef.Create(nil, dtConst);
|
||||
end
|
||||
|
||||
else
|
||||
if (s = 'procedure') or (s = 'type') then
|
||||
Result:=nil
|
||||
else
|
||||
exit;
|
||||
if CurObjName = '' then begin
|
||||
d.Free;
|
||||
continue;
|
||||
end;
|
||||
|
||||
if Result <> nil then begin
|
||||
Result.Name:=name;
|
||||
Result.SymId:=id;
|
||||
// Common def attributes
|
||||
d.Name:=CurObjName;
|
||||
d.DefId:=it.Get('Id', -1);
|
||||
d.SymId:=it.Get('SymId', -1);
|
||||
s:=it.Get('Visibility', '');
|
||||
d.IsPrivate:=(s <> '') and (s <> 'public') and (s <> 'published');
|
||||
|
||||
// Specific def attributes
|
||||
case d.DefType of
|
||||
dtClass:
|
||||
with TClassDef(d) do begin
|
||||
AncestorClass:=TClassDef(_GetRef(it.Get('Ancestor', TJSONObject(nil)), TClassDef));
|
||||
_ReadDefs(d, it, 'Fields');
|
||||
end;
|
||||
dtRecord:
|
||||
with TRecordDef(d) do begin
|
||||
Size:=it.Integers['Size'];
|
||||
_ReadDefs(d, it, 'Fields');
|
||||
end;
|
||||
dtProc, dtProcType:
|
||||
with TProcDef(d) do begin
|
||||
arr:=it.Get('Options', TJSONArray(nil));
|
||||
if arr <> nil then
|
||||
for j:=0 to arr.Count - 1 do begin
|
||||
s:=arr.Strings[j];
|
||||
if s = 'procedure' then
|
||||
ProcType:=ptProcedure
|
||||
else
|
||||
if s = 'function' then
|
||||
ProcType:=ptFunction
|
||||
else
|
||||
if s = 'constructor' then begin
|
||||
ProcType:=ptConstructor;
|
||||
if CompareText(Name, 'create') = 0 then
|
||||
Name:='Create'; // fix char case for standard constructors
|
||||
end
|
||||
else
|
||||
if s = 'destructor' then
|
||||
ProcType:=ptDestructor
|
||||
else
|
||||
if s = 'overriding' then begin
|
||||
ProcType:=ptDestructor;
|
||||
ProcOpt:=ProcOpt + [poOverride];
|
||||
if ProcType <> ptConstructor then
|
||||
IsPrivate:=True;
|
||||
end
|
||||
else
|
||||
if s = 'overload' then
|
||||
ProcOpt:=ProcOpt + [poOverload]
|
||||
else
|
||||
if s = 'overload' then
|
||||
ProcOpt:=ProcOpt + [poMethodPtr]
|
||||
else
|
||||
if s = 'abstract' then
|
||||
TClassDef(Parent).HasAbstractMethods:=True;
|
||||
end;
|
||||
|
||||
Inc(level, LInc);
|
||||
skiplevel:=level;
|
||||
Inc(idx);
|
||||
while idx < FLines.Count do begin
|
||||
s:=FLines[idx];
|
||||
if not _ThisLevel(s) or (Copy(Trim(s), 1, 3) = '---') then begin
|
||||
Dec(idx);
|
||||
break;
|
||||
end;
|
||||
ReturnType:=_GetRef(it.Get('RetType', TJSONObject(nil)));
|
||||
if (DefType = dtProcType) and not ( (ReturnType is TTypeDef) and (TTypeDef(ReturnType).BasicType = btVoid) ) then
|
||||
ProcType:=ptFunction;
|
||||
if it.Get('MethodPtr', False) then
|
||||
ProcOpt:=ProcOpt + [poMethodPtr];
|
||||
|
||||
if Pos('Visibility :', s) > 0 then begin
|
||||
s:=LowerCase(Trim(ExtractWord(2, s, [':'])));
|
||||
if (s <> 'public') and (s <> 'published') then begin
|
||||
FreeAndNil(Result);
|
||||
exit;
|
||||
_ReadDefs(d, it, 'Params');
|
||||
end;
|
||||
end
|
||||
else
|
||||
if (Pos('Definition :', s) > 0) or (Pos('Result Type :', s) > 0) then begin
|
||||
if (Result = nil) or (Result.DefType <> dtConst) then begin
|
||||
s:=Trim(ExtractWord(2, s, [':']));
|
||||
d:=_GetDef(s);
|
||||
if (d <> nil) and (d.Name = '') then begin
|
||||
if (d.DefType = dtProc) and (TProcDef(d).ProcType = ptConstructor) and (CompareText(name, 'create') = 0) then
|
||||
name:='Create'; // fix char case for standard constructors
|
||||
d.Name:=name;
|
||||
d.SymId:=id;
|
||||
end;
|
||||
end
|
||||
end
|
||||
else
|
||||
if Pos('Options :', s) > 0 then begin
|
||||
s:=LowerCase(Trim(ExtractWord(2, s, [':'])));
|
||||
if Pos('hidden', s) > 0 then begin
|
||||
FreeAndNil(Result);
|
||||
exit;
|
||||
end;
|
||||
end
|
||||
else
|
||||
if Result <> nil then
|
||||
case Result.DefType of
|
||||
dtVar, dtField, dtProp, dtParam:
|
||||
if (Pos('Var Type :', s) > 0) or (Pos('Prop Type :', s) > 0) then begin
|
||||
s:=Trim(ExtractWord(2, s, [':']));
|
||||
TVarDef(Result).VarType:=_GetDef(s);
|
||||
end
|
||||
else
|
||||
if Pos('access :', s) > 0 then begin
|
||||
if Pos('Sym:', Trim(FLines[idx+1])) = 1 then begin
|
||||
d:=nil;
|
||||
ss:=Trim(ExtractWord(2, s, [':']));
|
||||
if Pos('Nil', ss) = 0 then
|
||||
d:=_GetDef(ss, TProcDef);
|
||||
with TVarDef(Result) do
|
||||
if Pos('Readaccess :', s) > 0 then begin
|
||||
VarOpt:=VarOpt + [voRead];
|
||||
if (d <> nil) and (d.Count = 1) then
|
||||
IndexType:=TVarDef(d[0]).VarType;
|
||||
end
|
||||
else
|
||||
if Pos('Writeaccess :', s) > 0 then begin
|
||||
VarOpt:=VarOpt + [voWrite];
|
||||
if (d <> nil) and (d.Count = 2) then
|
||||
IndexType:=TVarDef(d[0]).VarType;
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else
|
||||
if Pos('Spez :', s) > 0 then begin
|
||||
with TVarDef(Result) do begin
|
||||
s:=LowerCase(Trim(ExtractWord(2, s, [':'])));
|
||||
dtVar, dtField, dtParam:
|
||||
with TVarDef(d) do begin
|
||||
VarType:=_GetRef(it.Objects['VarType']);
|
||||
s:=it.Get('Spez', '');
|
||||
if s = 'out' then
|
||||
VarOpt:=[voWrite, voOut]
|
||||
else
|
||||
@ -453,72 +506,58 @@ var
|
||||
if s = 'const' then
|
||||
VarOpt:=[voRead, voConst];
|
||||
end;
|
||||
end;
|
||||
dtProp:
|
||||
with TVarDef(d) do begin
|
||||
VarType:=_GetRef(it.Objects['PropType']);
|
||||
if it.Get('Getter', TJSONObject(nil)) <> nil then
|
||||
VarOpt:=VarOpt + [voRead];
|
||||
if it.Get('Setter', TJSONObject(nil)) <> nil then
|
||||
VarOpt:=VarOpt + [voWrite];
|
||||
|
||||
arr:=it.Get('Params', TJSONArray(nil));
|
||||
if (arr <> nil) and (arr.Count = 1) then
|
||||
IndexType:=_GetRef(arr.Objects[0].Objects['VarType']);
|
||||
end;
|
||||
dtEnum:
|
||||
_ReadDefs(d, it, 'Elements');
|
||||
dtSet:
|
||||
with TSetDef(d) do begin
|
||||
Size:=it.Integers['Size'];
|
||||
Base:=it.Integers['Base'];
|
||||
ElMax:=it.Integers['Max'];
|
||||
ElType:=TTypeDef(_GetRef(it.Objects['ElType'], TTypeDef));
|
||||
end;
|
||||
dtConst:
|
||||
begin
|
||||
j:=Pos('Value :', s);
|
||||
if j > 0 then begin
|
||||
Inc(j, 6);
|
||||
ss:=Trim(Copy(s, j + 1, MaxInt));
|
||||
if Copy(ss, 1, 1) = '"' then begin
|
||||
Delete(ss, 1, 1);
|
||||
i:=level - LInc;
|
||||
while True do begin
|
||||
Inc(idx);
|
||||
if idx >= FLines.Count then
|
||||
break;
|
||||
s:=FLines[idx];
|
||||
if (Copy(s, i, 3) = '** ') or (Copy(s, j, 1) = ':') then
|
||||
break;
|
||||
ss:=ss + #10 + s;
|
||||
end;
|
||||
Dec(idx);
|
||||
Delete(ss, Length(ss), 1);
|
||||
ss:=StringReplace(ss, '\', '\\', [rfReplaceAll]);
|
||||
ss:=StringReplace(ss, '"', '\"', [rfReplaceAll]);
|
||||
ss:=StringReplace(ss, #10, '\n', [rfReplaceAll]);
|
||||
ss:='"' + ss + '"';
|
||||
end;
|
||||
TConstDef(Result).Value:=ss;
|
||||
with TConstDef(d) do begin
|
||||
VarType:=_GetRef(it.Get('TypeRef', TJSONObject(nil)));
|
||||
s:=it.Strings['ValType'];
|
||||
if s = 'int' then
|
||||
Value:=IntToStr(it.Int64s['Value'])
|
||||
else
|
||||
if s = 'float' then begin
|
||||
Str(it.Floats['Value'], s);
|
||||
Value:=s;
|
||||
end
|
||||
else
|
||||
if Pos('OrdinalType :', s) > 0 then begin
|
||||
s:=Trim(ExtractWord(2, s, [':']));
|
||||
TConstDef(Result).VarType:=_GetDef(s);
|
||||
if s = 'string' then begin
|
||||
s:=it.Strings['Value'];
|
||||
s:=StringReplace(s, '\', '\\', [rfReplaceAll]);
|
||||
s:=StringReplace(s, '"', '\"', [rfReplaceAll]);
|
||||
s:=StringReplace(s, #9, '\t', [rfReplaceAll]);
|
||||
s:=StringReplace(s, #10, '\n', [rfReplaceAll]);
|
||||
s:=StringReplace(s, #13, '\r', [rfReplaceAll]);
|
||||
Value:='"' + s + '"';
|
||||
end
|
||||
else
|
||||
if Pos('Set Type :', s) > 0 then begin
|
||||
// s:=Trim(ExtractWord(2, s, [':']));
|
||||
// TConstDef(Result).VarType:=_GetDef(s);
|
||||
FreeAndNil(Result);
|
||||
exit;
|
||||
FreeAndNil(d);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
Inc(idx);
|
||||
end;
|
||||
|
||||
if Result <> nil then
|
||||
ParentDef.Add(Result);
|
||||
end;
|
||||
|
||||
procedure _RemoveCurDef;
|
||||
var
|
||||
d: TDef;
|
||||
begin
|
||||
d:=CurDef;
|
||||
CurDef:=CurDef.Parent;
|
||||
d.Free;
|
||||
skiplevel:=level;
|
||||
end;
|
||||
|
||||
var
|
||||
s: ansistring;
|
||||
i, j: integer;
|
||||
dd: TDef;
|
||||
HdrRead: boolean;
|
||||
s: string;
|
||||
begin
|
||||
Result:=nil;
|
||||
for i:=0 to Units.Count - 1 do
|
||||
@ -534,308 +573,38 @@ begin
|
||||
exit;
|
||||
end;
|
||||
|
||||
FLines:=TStringList.Create;
|
||||
s:=ReadUnit(AUnitName);
|
||||
try
|
||||
ReadUnit(AUnitName, FLines);
|
||||
junit:=nil;
|
||||
try
|
||||
jp:=TJSONParser.Create(s);
|
||||
try
|
||||
junit:=TJSONObject(jp.Parse.Items[0]);
|
||||
finally
|
||||
jp.Free;
|
||||
end;
|
||||
|
||||
IsSystemUnit:=CompareText(AUnitName, 'system') = 0;
|
||||
|
||||
Result:=TUnitDef.Create(nil, dtUnit);
|
||||
Units.Add(Result);
|
||||
Result.Name:=junit.Strings['Name'];
|
||||
Result.PPUVer:=junit.Integers['Version'];
|
||||
Result.CPU:=junit.Strings['TargetCPU'];
|
||||
Result.OS:=junit.Strings['TargetOS'];
|
||||
Result.IntfCRC:=junit.Strings['InterfaceCRC'];
|
||||
|
||||
if junit.Find('Units') <> nil then
|
||||
with junit.Arrays['Units'] do begin
|
||||
SetLength(deref, Count);
|
||||
for i:=0 to Count - 1 do begin
|
||||
deref[i]:=TUnitDef.Create(nil, dtNone);
|
||||
deref[i].Name:=Strings[i];
|
||||
end;
|
||||
end;
|
||||
|
||||
CurUnit:=Result;
|
||||
SetLength(deref, 0);
|
||||
CurDef:=Result;
|
||||
level:=1;
|
||||
skiplevel:=0;
|
||||
i:=-1;
|
||||
HdrRead:=False;
|
||||
while True do begin
|
||||
Inc(i);
|
||||
if i >= FLines.Count then
|
||||
break;
|
||||
s:=FLines[i];
|
||||
|
||||
if s = 'Implementation symtable' then
|
||||
break;
|
||||
|
||||
if not HdrRead then begin
|
||||
if Trim(s) = 'Interface symtable' then begin
|
||||
HdrRead:=True;
|
||||
continue;
|
||||
end;
|
||||
|
||||
if Pos('Analyzing', s) = 1 then begin
|
||||
j:=Pos('(v', s);
|
||||
if j > 0 then
|
||||
Result.PPUVer:=StrToInt(Copy(s, j + 2, Length(s) - j - 2));
|
||||
end
|
||||
else
|
||||
if Pos('Target processor', s) = 1 then
|
||||
Result.CPU:=Trim(ExtractWord(2, s, [':']))
|
||||
else
|
||||
if Pos('Target operating system', s) = 1 then
|
||||
Result.OS:=Trim(ExtractWord(2, s, [':']))
|
||||
else
|
||||
if Pos('Interface Checksum', s) = 1 then
|
||||
Result.IntfCRC:=Trim(ExtractWord(2, s, [':']))
|
||||
else
|
||||
if (Pos('Module Name:', s) = 1) and (Result.Name = '') then begin
|
||||
Result.Name:=Trim(ExtractWord(2, s, [':']));
|
||||
continue;
|
||||
end
|
||||
else
|
||||
if Pos('DerefMap[', s) = 1 then begin
|
||||
s:=Trim(ExtractWord(2, s, ['=']));
|
||||
j:=Length(deref);
|
||||
SetLength(deref, j + 1);
|
||||
deref[j]:=TUnitDef.Create(nil, dtNone);
|
||||
deref[j].Name:=s;
|
||||
continue;
|
||||
end;
|
||||
end;
|
||||
|
||||
while not _ThisLevel(s) do begin
|
||||
if skiplevel = 0 then
|
||||
CurDef:=CurDef.Parent;
|
||||
Dec(level, LInc);
|
||||
skiplevel:=0;
|
||||
end;
|
||||
|
||||
if level = skiplevel then
|
||||
continue; // Skipping not supported entries
|
||||
|
||||
// Definition
|
||||
j:=Pos(SDefId, s);
|
||||
if j > 0 then begin
|
||||
Inc(level, LInc);
|
||||
// def id
|
||||
j:=StrToInt(Copy(s, j + Length(SDefId), Length(s) - (j + Length(SDefId)) - 2));
|
||||
Inc(i);
|
||||
s:=FLines[i];
|
||||
if Pos('definition', s) = 0 then begin
|
||||
skiplevel:=level;
|
||||
continue;
|
||||
end;
|
||||
s:=LowerCase(Trim(ExtractWord(1, s, [' '])));
|
||||
dd:=nil;
|
||||
if s = 'object/class' then
|
||||
dd:=TClassDef.Create(CurDef, dtClass)
|
||||
else
|
||||
if s = 'record' then
|
||||
dd:=TRecordDef.Create(CurDef, dtRecord)
|
||||
else
|
||||
if s = 'procedure' then
|
||||
dd:=TProcDef.Create(CurDef, dtProc)
|
||||
else
|
||||
if s = 'ordinal' then begin
|
||||
dd:=TTypeDef.Create(CurDef, dtType);
|
||||
TTypeDef(dd).BasicType:=btLongInt;
|
||||
end
|
||||
else
|
||||
if Pos('string', s) > 0 then begin
|
||||
dd:=TTypeDef.Create(CurDef, dtType);
|
||||
dd.Name:=s;
|
||||
if (s = 'widestring') or (s = 'unicodestring') then
|
||||
TTypeDef(dd).BasicType:=btWideString
|
||||
else
|
||||
TTypeDef(dd).BasicType:=btString;
|
||||
end
|
||||
else
|
||||
if s = 'float' then begin
|
||||
dd:=TTypeDef.Create(CurDef, dtType);
|
||||
TTypeDef(dd).BasicType:=btDouble;
|
||||
end
|
||||
else
|
||||
if s = 'enumeration' then begin
|
||||
dd:=TTypeDef.Create(CurDef, dtEnum);
|
||||
TTypeDef(dd).BasicType:=btEnum;
|
||||
end
|
||||
else
|
||||
if s = 'pointer' then begin
|
||||
dd:=TTypeDef.Create(CurDef, dtType);
|
||||
TTypeDef(dd).BasicType:=btPointer;
|
||||
end
|
||||
else
|
||||
if s = 'procedural' then begin
|
||||
dd:=TProcDef.Create(CurDef, dtProcType);
|
||||
TProcDef(dd).ProcType:=ptProcedure;
|
||||
end
|
||||
else
|
||||
if s = 'set' then begin
|
||||
dd:=TSetDef.Create(CurDef, dtSet);
|
||||
end
|
||||
else
|
||||
skiplevel:=level;
|
||||
if dd <> nil then begin
|
||||
CurDef:=dd;
|
||||
CurDef.DefId:=j;
|
||||
end;
|
||||
continue;
|
||||
end;
|
||||
|
||||
// Symbol
|
||||
if Pos(SSymId, s) > 0 then begin
|
||||
dd:=_ReadSym(i, CurDef);
|
||||
continue;
|
||||
end;
|
||||
|
||||
if CurDef <> nil then
|
||||
case CurDef.DefType of
|
||||
dtClass:
|
||||
begin
|
||||
if Pos('Type :', Trim(s)) = 1 then begin
|
||||
s:=LowerCase(Trim(ExtractWord(2, s, [':'])));
|
||||
if CurDef.DefId = 0 then
|
||||
s:=s;
|
||||
if s <> 'class' then
|
||||
_RemoveCurDef;
|
||||
end
|
||||
else
|
||||
if Pos('Ancestor Class :', s) > 0 then begin
|
||||
s:=Trim(ExtractWord(2, s, [':']));
|
||||
TClassDef(CurDef).AncestorClass:=TClassDef(_GetDef(s, TClassDef));
|
||||
end
|
||||
end;
|
||||
dtRecord:
|
||||
begin
|
||||
if IsSystemUnit and (Pos('Name of Record :', s) > 0) then begin
|
||||
s:=Trim(ExtractWord(2, s, [':']));
|
||||
if CompareText(s, 'tguid') = 0 then begin
|
||||
dd:=TTypeDef.Create(CurUnit, dtType);
|
||||
TTypeDef(dd).BasicType:=btGuid;
|
||||
dd.DefId:=CurDef.DefId;
|
||||
CurDef.Free;
|
||||
CurDef:=dd;
|
||||
end;
|
||||
end
|
||||
else
|
||||
if Pos('DataSize :', s) > 0 then begin
|
||||
s:=Trim(ExtractWord(2, s, [':']));
|
||||
TRecordDef(CurDef).Size:=StrToInt(s);
|
||||
end;
|
||||
end;
|
||||
dtProc, dtProcType:
|
||||
begin
|
||||
s:=Trim(s);
|
||||
if Pos('TypeOption :', s) = 1 then begin
|
||||
s:=LowerCase(Trim(ExtractWord(2, s, [':'])));
|
||||
with TProcDef(CurDef) do
|
||||
if s = 'procedure' then
|
||||
ProcType:=ptProcedure
|
||||
else
|
||||
if s = 'function' then
|
||||
ProcType:=ptFunction
|
||||
else
|
||||
if s = 'constructor' then
|
||||
ProcType:=ptConstructor
|
||||
else
|
||||
if s = 'destructor' then
|
||||
ProcType:=ptDestructor;
|
||||
end
|
||||
else
|
||||
if Pos('Return type :', s) = 1 then begin
|
||||
s:=Trim(ExtractWord(2, s, [':']));
|
||||
with TProcDef(CurDef) do begin
|
||||
ReturnType:=_GetDef(s);
|
||||
if (CurDef.DefType = dtProcType) and not ( (ReturnType is TTypeDef) and (TTypeDef(ReturnType).BasicType = btVoid) ) then
|
||||
ProcType:=ptFunction;
|
||||
end;
|
||||
end
|
||||
else
|
||||
if Pos('Visibility :', s) = 1 then begin
|
||||
s:=LowerCase(Trim(ExtractWord(2, s, [':'])));
|
||||
if (s <> 'public') and (s <> 'published') then
|
||||
CurDef.IsPrivate:=True;
|
||||
end
|
||||
else
|
||||
if Pos('Options :', s) = 1 then begin
|
||||
s:=LowerCase(Trim(ExtractWord(2, s, [':'])));
|
||||
with TProcDef(CurDef) do begin
|
||||
if Pos('overridingmethod', s) > 0 then begin
|
||||
ProcOpt:=ProcOpt + [poOverride];
|
||||
if ProcType <> ptConstructor then
|
||||
CurDef.IsPrivate:=True;
|
||||
end;
|
||||
if Pos('overload', s) > 0 then
|
||||
ProcOpt:=ProcOpt + [poOverload];
|
||||
if Pos('methodpointer', s) > 0 then
|
||||
ProcOpt:=ProcOpt + [poMethodPtr];
|
||||
|
||||
if (CurDef.Parent.DefType = dtClass) and (Pos('abstractmethod', s) > 0) then
|
||||
TClassDef(CurDef.Parent).HasAbstractMethods:=True;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
dtType:
|
||||
with TTypeDef(CurDef) do
|
||||
if Pos('Base type :', s) > 0 then begin
|
||||
s:=LowerCase(Trim(ExtractWord(2, s, [':'])));
|
||||
if Pos('bool', s) = 1 then
|
||||
BasicType:=btBoolean
|
||||
else
|
||||
if s = 'u8bit' then
|
||||
BasicType:=btByte
|
||||
else
|
||||
if s = 's8bit' then
|
||||
BasicType:=btShortInt
|
||||
else
|
||||
if s = 'u16bit' then
|
||||
BasicType:=btWord
|
||||
else
|
||||
if s = 's16bit' then
|
||||
BasicType:=btSmallInt
|
||||
else
|
||||
if s = 'u32bit' then
|
||||
BasicType:=btLongWord
|
||||
else
|
||||
if s = 's32bit' then
|
||||
BasicType:=btLongInt
|
||||
else
|
||||
if (s = 'u64bit') or (s = 's64bit') then
|
||||
BasicType:=btInt64
|
||||
else
|
||||
if s = 'uvoid' then
|
||||
BasicType:=btVoid
|
||||
else
|
||||
if s = 'uchar' then
|
||||
BasicType:=btChar
|
||||
else
|
||||
if s = 'uwidechar' then
|
||||
BasicType:=btWideChar;
|
||||
end
|
||||
else
|
||||
if Pos('Float type :', s) > 0 then begin
|
||||
s:=Trim(ExtractWord(2, s, [':']));
|
||||
if s = '0' then
|
||||
BasicType:=btSingle;
|
||||
end
|
||||
else
|
||||
if Pos('Range :', s) > 0 then begin
|
||||
s:=LowerCase(Trim(ExtractWord(2, s, [':'])));
|
||||
if s = '0 to 1' then
|
||||
BasicType:=btBoolean;
|
||||
end;
|
||||
dtSet:
|
||||
with TSetDef(CurDef) do
|
||||
if Pos('Size :', s) > 0 then
|
||||
Size:=StrToInt(Trim(ExtractWord(2, s, [':'])))
|
||||
else
|
||||
if Pos('Set Base :', s) > 0 then
|
||||
Base:=StrToInt(Trim(ExtractWord(2, s, [':'])))
|
||||
else
|
||||
if Pos('Set Max :', s) > 0 then
|
||||
ElMax:=StrToInt(Trim(ExtractWord(2, s, [':'])))
|
||||
else
|
||||
if Pos('Element type :', s) > 0 then
|
||||
ElType:=TTypeDef(_GetDef(Trim(ExtractWord(2, s, [':'])), TTypeDef))
|
||||
else
|
||||
if Pos('Type symbol :', s) > 0 then begin
|
||||
s:=LowerCase(Trim(ExtractWord(2, s, [':'])));
|
||||
if Trim(ExtractWord(2, s, [' '])) = 'nil' then
|
||||
_RemoveCurDef;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
_ReadDefs(CurUnit, junit, 'Interface');
|
||||
|
||||
Result.ResolveDefs;
|
||||
|
||||
@ -853,7 +622,12 @@ begin
|
||||
end;
|
||||
SetLength(Result.UsedUnits, j);
|
||||
finally
|
||||
FLines.Free;
|
||||
junit.Free;
|
||||
end;
|
||||
except
|
||||
if CurObjName <> '' then
|
||||
CurObjName:=Format('; Object: "%s"', [CurObjName]);
|
||||
raise Exception.CreateFmt('%s' + LineEnding + 'Unit: "%s"%s', [Exception(ExceptObject).Message, AUnitName, CurObjName]);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user