Update Lua Support

Source/RuntimeBuilder.Lua.pas

@@ -24,20 +24,18 @@ type
               end;
               TRTBLuaVar=class(TRTBVar)
                 protected
-                  //p:pointer;
+                  State:Plua_State;
-                  //&Type:TRTBType;
+                  Name:string;
-                  //procedure SetVal(Val:TValue);override;
+                  procedure SetVal(Val:TValue);override;
-                  //function GetVal:TValue;override;
+                  function GetVal:TValue;override;
                 public
-                  //constructor Create(p:pointer;&Type:TRTBType);
+                  constructor Create(Module:TRTBLuaModule;s:string);
-                  //destructor Destroy;override;
+                  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 &Register(const NameSpace,Name:string;&Type:TRTBType);override;
-          //procedure UnRegister(NameSpace:string;Name:string);override;
+          procedure UnRegister(const NameSpace,Name:string);override;
-          //procedure RegisterFunction(NameSpace:string;Name:string);override;
+          procedure RegisterFunction(const NameSpace,Name:string);override;
-          //procedure UnRegisterFunction(NameSpace:string;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
+  //else if Data.Kind=tkUnknown then
-    //PreDecl:=PreDecl+Key+': times '+ Value.DataSize.ToString+' db 0'+sLineBreak;
+  //  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

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
+if 1<>Func1.Call(TypeInfo(integer),[454],CRTBCallTypeStdCall).AsInteger then
-//  raise Exception.Create('Error in LuaTest');
+  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);