artem3213212/RuntimeBuilder
1
0
Fork 0
Code Issues 1 Pull Requests Releases Wiki Activity

Update Lua Support

Browse Source
This commit is contained in:
Artem3213212
2018-06-26 22:08:36 +03:00
parent aa794d7eb1
commit 37a09bd79a
4 changed files with 93 additions and 255 deletions
Download Patch File Download Diff File Expand all files Collapse all files

338
Source/RuntimeBuilder.Lua.pas
View File

@@ -24,20 +24,18 @@ type
end;
TRTBLuaVar=class(TRTBVar)
protected
//p:pointer;
//&Type:TRTBType;
//procedure SetVal(Val:TValue);override;
//function GetVal:TValue;override;
State:Plua_State;
Name:string;
procedure SetVal(Val:TValue);override;
function GetVal:TValue;override;
public
//constructor Create(p:pointer;&Type:TRTBType);
//destructor Destroy;override;
constructor Create(Module:TRTBLuaModule;s:string);
destructor Destroy;override;
end;
private
State:Plua_State;
//funcs:TDictionary<string,NativeUInt>;
//regvars:TDictionary<string,TPair<NativeUInt,PTypeInfo>>;
function GetFuntion(Name:string):TRTBFunc;override;
//function GetVar(Name:string):TRTBVar;override;
function GetVar(Name:string):TRTBVar;override;
public
constructor Create(AState:Plua_State);
destructor Destroy;override;
@@ -73,12 +71,13 @@ type
//procedure ExportVariable(NameSpace:string;Name:string;var Data);override;
//procedure DelVariable(NameSpace:string;Name:string);override;
//procedure &Register(NameSpace:string;Name:string;&Type:TRTBType);override;
//procedure UnRegister(NameSpace:string;Name:string);override;
//procedure RegisterFunction(NameSpace:string;Name:string);override;
//procedure UnRegisterFunction(NameSpace:string;Name:string);override;
procedure &Register(const NameSpace,Name:string;&Type:TRTBType);override;
procedure UnRegister(const NameSpace,Name:string);override;
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;
@@ -98,233 +97,6 @@ uses System.SysUtils;
const
cCurLang=cLuaLangName;
(*constructor TRTBLuaCompiler.TRTBLuaSource.TRTBLuaModule.TRTBLuaFunc.Create(p:Pointer);
begin
inherited Create();
Self.p:=p;
end;
function TRTBFasmCompiler.TRTBFasmSource.TRTBFasmModule.TRTBFasmFunc.Call(OutType:PTypeInfo;args:TArray<TValue>;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;
begin
{$IFDEF CPUX64}
Result:=Invoke(p,args,ccReg,OutType);
{$ELSE}
case CallType of
CRTBCallTypeRegister:Result:=Invoke(p,args,ccReg,OutType);
CRTBCallTypeStdCall:Result:=Invoke(p,args,ccStdCall,OutType);
CRTBCallTypeCdecl:Result:=Invoke(p,args,ccCdecl,OutType);
CRTBCallTypePascal:Result:=Invoke(p,args,ccPascal,OutType);
CRTBCallTypeSafeCall:Result:=Invoke(p,args,ccSafeCall,OutType);
end;
{$ENDIF}
end;
destructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmModule.TRTBFasmFunc.Destroy;
begin
p:=nil;
end;
procedure TRTBFasmCompiler.TRTBFasmSource.TRTBFasmModule.TRTBFasmVar.SetVal(Val:TValue);
begin
if Val.TypeInfo=&Type then
Val.ExtractRawData(p);
end;
function TRTBFasmCompiler.TRTBFasmSource.TRTBFasmModule.TRTBFasmVar.GetVal:TValue;
begin
TValue.Make(p,&Type,Result);
end;
constructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmModule.TRTBFasmVar.Create(p:pointer;&Type:TRTBType);
begin
Self.p:=p;
Self.&Type:=&Type;
end;
destructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmModule.TRTBFasmVar.Destroy;
begin
p:=nil;
&Type:=nil;
end;
function TRTBFasmCompiler.TRTBFasmSource.TRTBFasmModule.GetFuntion(Name:string):TRTBFunc;
begin
Result:=TRTBFasmFunc.Create(PPointer(NativeUInt(funcs.Items[Name])+NativeUInt(p))^);
end;
function TRTBFasmCompiler.TRTBFasmSource.TRTBFasmModule.GetVar(Name:string):TRTBVar;
begin
Result:=TRTBFasmVar.Create(PPointer(NativeUInt(regvars.Items[Name].Key)+NativeUInt(p))^,regvars.Items[Name].Value)
end;
constructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmModule.Create(p:Pointer;sb:NativeUInt;funcs:TDictionary<string,NativeUInt>;regvars:TDictionary<string,TPair<NativeUInt,PTypeInfo>>);
begin
Self.p:=p;
Self.sb:=sb;
Self.funcs:=funcs;
Self.regvars:=regvars;
end;
destructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmModule.Destroy;
begin
VirtualFree(p,sb,MEM_RELEASE);
end;
function TRTBFasmCompiler.TRTBFasmSource.GetIncLibs():string;
var
i:integer;
begin
Result:='';
for i:=0 to libs.count-1 do
Result:=Result+sLineBreak+'include '+#39+libs.Strings[i]+#39;
end;
function TRTBFasmCompiler.TRTBFasmSource.GetText:string;
begin
Result:=FText;
end;
procedure TRTBFasmCompiler.TRTBFasmSource.SetText(S:string);
begin
FText:=S;
end;
procedure TRTBFasmCompiler.TRTBFasmSource.AddNameSpace(Name:string);
begin
end;
procedure TRTBFasmCompiler.TRTBFasmSource.DelNameSpace(Name:string);
label
funcscontinue,regvarscontinue,constscontinue;
var
i,i0:NativeUInt;
begin
Name:=Name+'.';
i:=0;
while i<funcs.Count do
begin
for i0:=1 to length(Name) do
if funcs.Strings[i][i0]=Name[i0]then
goto funcscontinue;
funcs.Delete(i);
inc(i);
funcscontinue:
end;
i:=0;
while i<regvars.Count do
begin
for i0:=1 to length(Name) do
if regvars.Items[i].Key[i0]=Name[i0]then
goto regvarscontinue;
regvars.Delete(i);
inc(i);
regvarscontinue:
end;
i:=0;
while i<consts.Count do
begin
for i0:=1 to length(Name) do
if consts.Items[i].Key[i0]=Name[i0]then
goto constscontinue;
consts.Delete(i);
inc(i);
constscontinue:
end;
end;
procedure TRTBFasmCompiler.TRTBFasmSource.AddType(NameSpace:string;Name:string;&Type:TRTBType);
begin
end;
procedure TRTBFasmCompiler.TRTBFasmSource.DelType(NameSpace:string;Name:string);
begin
end;
procedure TRTBFasmCompiler.TRTBFasmSource.AddConst(NameSpace:string;Name:string;Val:TValue);
begin
if NameSpace<>'' then
consts.Add(TPair<string,TValue>.Create(NameSpace+'.'+Name,Val))
else
consts.Add(TPair<string,TValue>.Create(Name,Val));
end;
procedure TRTBFasmCompiler.TRTBFasmSource.DelConst(NameSpace:string;Name:string);
var
i:NativeUInt;
begin
if NameSpace<>'' then
Name:=NameSpace+'.'+Name;
if consts.Count<>0 then
for i:=0 to consts.Count-1 do
if consts.Items[i].Key=Name then
begin
consts.Delete(i);
Break;
end;
end;
procedure TRTBFasmCompiler.TRTBFasmSource.AddVariable(NameSpace:string;Name:string;var Data);
begin
if NameSpace<>'' then
consts.Add(TPair<string,TValue>.Create(NameSpace+'.'+Name,addr(Data)))
else
consts.Add(TPair<string,TValue>.Create(Name,addr(Data)));
end;
procedure TRTBFasmCompiler.TRTBFasmSource.ExportVariable(NameSpace:string;Name:string;var Data);
begin
if NameSpace<>'' then
consts.Add(TPair<string,TValue>.Create(NameSpace+'.'+Name,Addr(Data)))
else
consts.Add(TPair<string,TValue>.Create(Name,Addr(Data)));
end;
procedure TRTBFasmCompiler.TRTBFasmSource.DelVariable(NameSpace:string;Name:string);
begin
DelConst(NameSpace,Name);
end;
procedure TRTBFasmCompiler.TRTBFasmSource.&Register(NameSpace:string;Name:string;&Type:TRTBType);
begin
if NameSpace<>'' then
regvars.Add(TPair<string,PTypeInfo>.Create(NameSpace+'.'+Name,&Type))
else
regvars.Add(TPair<string,PTypeInfo>.Create(Name,&Type));
end;
procedure TRTBFasmCompiler.TRTBFasmSource.UnRegister(NameSpace:string;Name:string);
var
i:NativeUInt;
begin
if NameSpace<>'' then
Name:=NameSpace+'.'+Name;
if regvars.Count<>0 then
for i:=0 to regvars.Count-1 do
if regvars.Items[i].Key=Name then
begin
regvars.Delete(i);
Break;
end;
end;
procedure TRTBFasmCompiler.TRTBFasmSource.RegisterFunction(NameSpace:string;Name:string);
begin
if NameSpace<>'' then
funcs.Add(NameSpace+'.'+Name)
else
funcs.Add(Name);
end;
procedure TRTBFasmCompiler.TRTBFasmSource.UnRegisterFunction(NameSpace:string;Name:string);
var
i:NativeUInt;
begin
if NameSpace<>'' then
Name:=NameSpace+'.'+Name;
with funcs do
Delete(IndexOf(Name));
end;
{constructor TRTBLuaCompiler.TRTBLuaSource.TRTBLuaFunc.Create(p:Pointer;sb:NativeUInt);
begin
Self.p:=VirtualAlloc(nil,sb,MEM_COMMIT ,PAGE_EXECUTE_READWRITE);
@@ -367,31 +139,61 @@ end;
destructor TRTBLuaCompiler.TRTBLuaSource.TRTBLuaLib.Destroy;
begin
FreeLibrary(Lib);
end;*)
end;}
constructor TRTBLuaCompiler.TRTBLuaSource.TRTBLuaModule.TRTBLuaFunc.Create(Module:TRTBLuaModule;s:string);
begin
Name:=s;
Module:=Module
State:=Module.State;
end;
function TRTBLuaCompiler.TRTBLuaSource.TRTBLuaModule.TRTBLuaFunc.Call(OutType:PTypeInfo;args:TArray<TValue>;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;
var
i:TValue;
begin
lua_getfield(State,LUA_GLOBALSINDEX,PAnsiChar(Name));
for i in args do
TRTBLuaCompiler.TRTBLuaSource.AddToStack(State,i);
TRTBLuaSource.AddToStack(State,i);
lua_pcall(State,length(args),1);
Result:=TRTBLuaSource.GetFromStack(State);
end;
destructor TRTBLuaCompiler.TRTBLuaSource.TRTBLuaModule.TRTBLuaFunc.Destroy;
begin
end;
procedure TRTBLuaCompiler.TRTBLuaSource.TRTBLuaModule.TRTBLuaVar.SetVal(Val:TValue);
begin
TRTBLuaSource.AddToStack(State,Val);
lua_setfield(State,LUA_GLOBALSINDEX,PAnsiChar(Name));
end;
function TRTBLuaCompiler.TRTBLuaSource.TRTBLuaModule.TRTBLuaVar.GetVal:TValue;
begin
lua_getfield(State,LUA_GLOBALSINDEX,PAnsiChar(Name));
Result:=TRTBLuaSource.GetFromStack(State);
end;
constructor TRTBLuaCompiler.TRTBLuaSource.TRTBLuaModule.TRTBLuaVar.Create(Module:TRTBLuaModule;s:string);
begin
Name:=s;
State:=Module.State;
end;
destructor TRTBLuaCompiler.TRTBLuaSource.TRTBLuaModule.TRTBLuaVar.Destroy;
begin
end;
function TRTBLuaCompiler.TRTBLuaSource.TRTBLuaModule.GetFuntion(Name:string):TRTBFunc;
begin
Result:=TRTBLuaFunc.Create(self,Name);
end;
function TRTBLuaCompiler.TRTBLuaSource.TRTBLuaModule.GetVar(Name:string):TRTBVar;
begin
Result:=TRTBLuaVar.Create(self,Name);
end;
constructor TRTBLuaCompiler.TRTBLuaSource.TRTBLuaModule.Create(AState:Plua_State);
begin
State:=AState;
@@ -433,6 +235,22 @@ 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;
@@ -442,7 +260,7 @@ with Data do
if IsType<AnsiString> or IsType<RawByteString> or IsType<UTF8String> then
lua_pushstring(State,PAnsiChar(AsType<AnsiString>))
else if IsType<ShortString> then
lua_pushstring(State,PAnsiChar(AsType<ShortString>))
lua_pushstring(State,PAnsiChar(String(AsType<ShortString>)))
else if IsType<WideString> then
lua_pushstring(State,PAnsiChar(AsType<WideString>))
else if IsType<UCS4String> then
@@ -467,10 +285,10 @@ with Data do
lua_pushlightuserdata(State,AsType<Pointer>)
else if IsArray then
begin
lua_createtable();
lua_createtable(State,Data.GetArrayLength,0);
for i:=0 to Data.GetArrayLength-1 do
begin
lua_pushinteger(i);
lua_pushinteger(State,i);
AddToStack(State,Data.GetArrayElement(i));
lua_settable(State,-3);
end;
@@ -478,16 +296,36 @@ with Data do
else if Data.Kind=tkRecord then
begin
rtype:=TRTTIContext.Create.GetType(Data.TypeInfo);
end
//else //if Value.Kind=tkUnknown then
//PreDecl:=PreDecl+Key+': times '+ Value.DataSize.ToString+' db 0'+sLineBreak;
//else if Data.Kind=tkUnknown then
// PreDecl:=PreDecl+Key+': times '+ Value.DataSize.ToString+' db 0'+sLineBreak;
else
begin
//lua_pushlightuserdata(State,);
end;
end;
class function TRTBLuaCompiler.TRTBLuaSource.GetFromStack(State:Plua_State):TValue;
begin
case lua_type(State,-1) of
LUA_TNIL: Result:=TValue.Empty;
LUA_TBOOLEAN: Result:=lua_toboolean(State,-1);
LUA_TLIGHTUSERDATA: Result:=lua_touserdata(State,-1);
LUA_TNUMBER:
begin
Result:=lua_tonumber(State,-1);
if Result.AsType<lua_Number> =Round(Result.AsType<lua_Number>) then
Result:=Round(Result.AsType<lua_Number>)
end;
LUA_TSTRING:Result:=lua_tostring(State,-1);
//LUA_TTABLE:Result:=lua_totable(State,-1);
//LUA_TFUNCTION:Result:=lua_tostring(State,-1);
LUA_TUSERDATA:Result:=lua_touserdata(State,-1);
LUA_TTHREAD:Result:=TValue.From<Plua_State>(lua_tothread(State,-1));
end;
lua_pop(State,1);
end;
function TRTBLuaCompiler.TRTBLuaSource.Compilate:TRTBModule;
procedure ConstParse(key:string;value:TValue;var PreDecl:string;var base:NativeUInt);
var
@@ -569,7 +407,7 @@ function TRTBLuaCompiler.TRTBLuaSource.Compilate:TRTBModule;
begin
PreDecl:=PreDecl+Key+':'+sLineBreak;
for i:=0 to Value.GetArrayLength-1 do
VarParse(key+'.i'+i.ToString,Value.GetArrayElement(i),PreDecl,Base);
//VarParse(key+'.i'+i.ToString,Value.GetArrayElement(i),PreDecl,Base);
end;
end
else //if Value.Kind=tkUnknown then

BIN
Source/RuntimeBuilder.pas
View File

Binary file not shown.

8
Tests/Unit1.pas
View File

@@ -86,17 +86,17 @@ Src.Text:='function main(n)'+sLineBreak+' return n'+sLineBreak+'end';
//Src.RegisterFunction('','varmain');
//Src.Register('','Pmain',TypeInfo(integer));
Module:=Src.Compilate;
//Func1:=Module.Funtion['main'];
Func1:=Module.Funtion['main'];
//Func2:=Module.Funtion['varmain'];
//if 1<>Func1.Call(TypeInfo(integer),[454],CRTBCallTypeStdCall).AsInteger then
// raise Exception.Create('Error in LuaTest');
if 1<>Func1.Call(TypeInfo(integer),[454],CRTBCallTypeStdCall).AsInteger then
raise Exception.Create('Error in LuaTest');
//Var1:=Module.&Var['Pmain'];
//Var1.Val:=424;
//if Var1.Val.AsInteger<>Func2.Call(TypeInfo(integer),[],CRTBCallTypeStdCall).AsInteger then
// raise Exception.Create('Error in LuaTest');
//FreeAndNil(Var1);
//FreeAndNil(Func2);
//FreeAndNil(Func1);
FreeAndNil(Func1);
FreeAndNil(module);
FreeAndNil(Src);
FreeAndNil(Lua);

2
lib/pLua-XE

Submodule lib/pLua-XE updated: 79883e7f4e...a5a7ab28f0