Complex RTTI Parsers Update

This commit is contained in:
2018-06-27 16:34:25 +03:00
parent 37a09bd79a
commit d3ddb74db5
2 changed files with 71 additions and 50 deletions

View File

@@ -371,10 +371,12 @@ end;
end;
function TRTBFasmCompiler.TRTBFasmSource.Compilate:TRTBModule;
procedure VarParse(key:string;value:TValue;var PreDecl:string;var base:NativeUInt);
procedure VarParse(key:string;Value:TValue;var PreDecl:string;var base:NativeUInt);
var
i:NativeUInt;
p0:PByte;
rfield:TRttiField;
rmetod:TRttiMethod;
begin
if Value.IsType<AnsiString> or Value.IsType<RawByteString> or Value.IsType<UTF8String> then
begin
@@ -419,12 +421,15 @@ function TRTBFasmCompiler.TRTBFasmSource.Compilate:TRTBModule;
inc(base,length(Value.AsType<UCS4String>)*4);
end
else if Value.IsOrdinal then
begin
case Value.DataSize of
1:PreDecl:=PreDecl+Key+' db '+Value.AsOrdinal.ToString+sLineBreak;
2:PreDecl:=PreDecl+Key+' dw '+Value.AsOrdinal.ToString+sLineBreak;
4:PreDecl:=PreDecl+Key+' dd '+Value.AsOrdinal.ToString+sLineBreak;
8:PreDecl:=PreDecl+Key+' dq '+Value.AsOrdinal.ToString+sLineBreak;
end
end;
inc(base,Value.DataSize);
end
else if Value.Kind=tkFloat then
begin
if Value.IsType<Single> then
@@ -445,7 +450,14 @@ function TRTBFasmCompiler.TRTBFasmSource.Compilate:TRTBModule;
PreDecl:=PreDecl+Key+' dd 0.0'+sLineBreak;
end
else if Value.Kind=tkPointer then
PreDecl:=PreDecl+Key+' equ '+NativeUInt(Value.AsType<Pointer>).ToString+sLineBreak
begin
case SizeOf(pointer) of
2:PreDecl:=PreDecl+Key+' dw '+NativeUInt(Value.AsType<Pointer>).ToString+sLineBreak;
4:PreDecl:=PreDecl+Key+' dd '+NativeUInt(Value.AsType<Pointer>).ToString+sLineBreak;
8:PreDecl:=PreDecl+Key+' dq '+NativeUInt(Value.AsType<Pointer>).ToString+sLineBreak;
end;
inc(base,SizeOf(pointer));
end
else if Value.IsArray then
begin
if Value.GetArrayLength=0 then
@@ -459,12 +471,22 @@ function TRTBFasmCompiler.TRTBFasmSource.Compilate:TRTBModule;
VarParse(key+'.i'+i.ToString,Value.GetArrayElement(i),PreDecl,Base);
end;
end
{else if Value.Kind=tkRecord then
else if Value.Kind=tkRecord or Value.IsClass then
begin
PreDecl:=PreDecl+Key+':'+sLineBreak;
for i:=1 to Value.TypeData.ManagedFldCount do
end}
for rfield in TRTTIContext.Create.GetType(Value.TypeInfo).GetFields do
VarParse(key+'.'+rfield.Name,rfield.GetValue(@Value),PreDecl,base);
for rmetod in TRTTIContext.Create.GetType(Value.TypeInfo).GetMethods do
begin
PreDecl:=PreDecl+key+'.'+rmetod.Name+' dd '+NativeUInt(rmetod.CodeAddress).ToString;
case SizeOf(pointer) of
2:PreDecl:=PreDecl+Key+' dw '+NativeUInt(Value.AsType<Pointer>).ToString+sLineBreak;
4:PreDecl:=PreDecl+Key+' dd '+NativeUInt(Value.AsType<Pointer>).ToString+sLineBreak;
8:PreDecl:=PreDecl+Key+' dq '+NativeUInt(Value.AsType<Pointer>).ToString+sLineBreak;
end;
inc(base,SizeOf(pointer));
end;
end
else //if Value.Kind=tkUnknown then
PreDecl:=PreDecl+Key+': times '+ Value.DataSize.ToString+' db 0'+sLineBreak;
end;
@@ -551,8 +573,8 @@ function TRTBFasmCompiler.TRTBFasmSource.Compilate:TRTBModule;
VarParse(key+'.i'+i.ToString,Value.GetArrayElement(i),PreDecl,Base);
end;
end
else //if Value.Kind=tkUnknown then
PreDecl:=PreDecl+Key+' equ 0'+sLineBreak;
else
VarParse(key,Value,PreDecl,Base);
end;
var
pointerDecl,PreDecl:string;

View File

@@ -49,6 +49,8 @@ type
//function GetIncLibs():string;
function GetText:string;override;
procedure SetText(const S:string);override;
class procedure AddToStack(State:Plua_State;Data:TValue);static;
class function GetFromStack(State:Plua_State):TValue;static;
public
constructor Create(Compiler:TRTBLuaCompiler);
@@ -76,9 +78,6 @@ type
procedure RegisterFunction(const NameSpace,Name:string);override;
procedure UnRegisterFunction(const NameSpace,Name:string);override;
class procedure AddToStack(State:Plua_State;Data:TValue);static;
class function GetFromStack(State:Plua_State):TValue;static;
function Compilate:TRTBModule;override;
destructor Destroy;override;
end;
@@ -154,7 +153,7 @@ begin
lua_getfield(State,LUA_GLOBALSINDEX,PAnsiChar(Name));
for i in args do
TRTBLuaSource.AddToStack(State,i);
lua_pcall(State,length(args),1);
lua_call(State,length(args),1);
Result:=TRTBLuaSource.GetFromStack(State);
end;
@@ -214,43 +213,6 @@ begin
FText:=S;
end;
constructor TRTBLuaCompiler.TRTBLuaSource.Create(Compiler:TRTBLuaCompiler);
begin
inherited Create(Compiler);
FText:='';
libs:=TStringList.Create;
funcs:=TStringList.Create;
regvars:=TList<TPair<string,PTypeInfo>>.Create;
consts:=TList<TPair<string,TValue>>.Create;
end;
procedure TRTBLuaCompiler.TRTBLuaSource.LoadLib(const Name:string);
begin
libs.Add(Name);
end;
procedure TRTBLuaCompiler.TRTBLuaSource.UnLoadLib(const Name:string);
begin
with libs do
Delete(IndexOf(Name));
end;
procedure TRTBLuaCompiler.TRTBLuaSource.&Register(const NameSpace,Name:string;&Type:TRTBType);
begin
end;
procedure TRTBLuaCompiler.TRTBLuaSource.UnRegister(const NameSpace,Name:string);
begin
end;
procedure TRTBLuaCompiler.TRTBLuaSource.RegisterFunction(const NameSpace,Name:string);
begin
end;
procedure TRTBLuaCompiler.TRTBLuaSource.UnRegisterFunction(const NameSpace,Name:string);
begin
end;
class procedure TRTBLuaCompiler.TRTBLuaSource.AddToStack(State:Plua_State;Data:TValue);
var
i:NativeUInt;
@@ -326,6 +288,43 @@ end;
lua_pop(State,1);
end;
constructor TRTBLuaCompiler.TRTBLuaSource.Create(Compiler:TRTBLuaCompiler);
begin
inherited Create(Compiler);
FText:='';
libs:=TStringList.Create;
funcs:=TStringList.Create;
regvars:=TList<TPair<string,PTypeInfo>>.Create;
consts:=TList<TPair<string,TValue>>.Create;
end;
procedure TRTBLuaCompiler.TRTBLuaSource.LoadLib(const Name:string);
begin
libs.Add(Name);
end;
procedure TRTBLuaCompiler.TRTBLuaSource.UnLoadLib(const Name:string);
begin
with libs do
Delete(IndexOf(Name));
end;
procedure TRTBLuaCompiler.TRTBLuaSource.&Register(const NameSpace,Name:string;&Type:TRTBType);
begin
end;
procedure TRTBLuaCompiler.TRTBLuaSource.UnRegister(const NameSpace,Name:string);
begin
end;
procedure TRTBLuaCompiler.TRTBLuaSource.RegisterFunction(const NameSpace,Name:string);
begin
end;
procedure TRTBLuaCompiler.TRTBLuaSource.UnRegisterFunction(const NameSpace,Name:string);
begin
end;
function TRTBLuaCompiler.TRTBLuaSource.Compilate:TRTBModule;
procedure ConstParse(key:string;value:TValue;var PreDecl:string;var base:NativeUInt);
var