diff --git a/Source/RuntimeBuilder.Lua.pas b/Source/RuntimeBuilder.Lua.pas index c4b9b8d..93ea2c5 100644 --- a/Source/RuntimeBuilder.Lua.pas +++ b/Source/RuntimeBuilder.Lua.pas @@ -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; - //regvars:TDictionary>; 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;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;regvars:TDictionary>); -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'' then - consts.Add(TPair.Create(NameSpace+'.'+Name,Val)) -else - consts.Add(TPair.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.Create(NameSpace+'.'+Name,addr(Data))) -else - consts.Add(TPair.Create(Name,addr(Data))); -end; - -procedure TRTBFasmCompiler.TRTBFasmSource.ExportVariable(NameSpace:string;Name:string;var Data); -begin -if NameSpace<>'' then - consts.Add(TPair.Create(NameSpace+'.'+Name,Addr(Data))) -else - consts.Add(TPair.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.Create(NameSpace+'.'+Name,&Type)) -else - regvars.Add(TPair.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;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 or IsType or IsType then lua_pushstring(State,PAnsiChar(AsType)) else if IsType then - lua_pushstring(State,PAnsiChar(AsType)) + lua_pushstring(State,PAnsiChar(String(AsType))) else if IsType then lua_pushstring(State,PAnsiChar(AsType)) else if IsType then @@ -467,10 +285,10 @@ with Data do lua_pushlightuserdata(State,AsType) 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 =Round(Result.AsType) then + Result:=Round(Result.AsType) +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(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 diff --git a/Source/RuntimeBuilder.pas b/Source/RuntimeBuilder.pas index 6597905..487fefb 100644 Binary files a/Source/RuntimeBuilder.pas and b/Source/RuntimeBuilder.pas differ diff --git a/Tests/Unit1.pas b/Tests/Unit1.pas index dc40814..31f867e 100644 --- a/Tests/Unit1.pas +++ b/Tests/Unit1.pas @@ -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); diff --git a/lib/pLua-XE b/lib/pLua-XE index 79883e7..a5a7ab2 160000 --- a/lib/pLua-XE +++ b/lib/pLua-XE @@ -1 +1 @@ -Subproject commit 79883e7f4e20d27cd48104024c54d78c210e498c +Subproject commit a5a7ab28f04d6b1c2a6e10209c9d9138b0a3a56f