466 lines
15 KiB
ObjectPascal
466 lines
15 KiB
ObjectPascal
unit RuntimeBuilder.Lua;
|
|
|
|
interface
|
|
|
|
uses
|
|
System.Classes,System.TypInfo,System.IOUtils,System.Rtti,Winapi.Windows,System.Generics.Collections,
|
|
pLuaObject,pLuaRecord,pLuaTable,uWordList,Lua,LuaObject,LuaWrapper,pLua,RuntimeBuilder;
|
|
|
|
type
|
|
TRTBLuaCompiler=class(TRTBCompiler)
|
|
protected type
|
|
TRTBLuaSource=class(TRTBSource)
|
|
protected type
|
|
TRTBLuaModule=class(TRTBModule)
|
|
protected type
|
|
TRTBLuaFunc=class(TRTBFunc)
|
|
protected
|
|
State:Plua_State;
|
|
Name:string;
|
|
public
|
|
constructor Create(Module:TRTBLuaModule;s:string);
|
|
function Call(OutType:PTypeInfo;args:TArray<TValue>;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;override;
|
|
destructor Destroy;override;
|
|
end;
|
|
TRTBLuaVar=class(TRTBVar)
|
|
protected
|
|
State:Plua_State;
|
|
Name:string;
|
|
procedure SetVal(Val:TValue);override;
|
|
function GetVal:TValue;override;
|
|
public
|
|
constructor Create(Module:TRTBLuaModule;s:string);
|
|
destructor Destroy;override;
|
|
end;
|
|
private
|
|
State:Plua_State;
|
|
function GetFuntion(Name:string):TRTBFunc;override;
|
|
function GetVar(Name:string):TRTBVar;override;
|
|
public
|
|
constructor Create(AState:Plua_State);
|
|
destructor Destroy;override;
|
|
end;
|
|
protected
|
|
libs:TStringList;
|
|
funcs:TStringList;
|
|
regvars:TList<TPair<string,PTypeInfo>>;
|
|
consts:TList<TPair<string,TValue>>;
|
|
FText:string;
|
|
//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);
|
|
|
|
procedure LoadLib(const Name:string);override;
|
|
procedure UnLoadLib(const Name:string);override;
|
|
|
|
//procedure AddNameSpace(Name:string);override;
|
|
//procedure DelNameSpace(Name:string);override;
|
|
|
|
//procedure AddType(NameSpace:string;Name:string;&Type:TRTBType);override;
|
|
//procedure DelType(NameSpace:string;Name:string);override;
|
|
|
|
//procedure AddConst(NameSpace:string;Name:string;Val:TValue);override;
|
|
//procedure DelConst(NameSpace:string;Name:string);override;
|
|
|
|
//procedure AddCallBack(NameSpace:string;Name:string;CallBack:TRTBCallBack);override;
|
|
//procedure DelCallBack(NameSpace:string;Name:string);override;
|
|
|
|
//procedure AddVariable(NameSpace:string;Name:string;var Data);override;
|
|
//procedure ExportVariable(NameSpace:string;Name:string;var Data);override;
|
|
//procedure DelVariable(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;
|
|
|
|
function Compilate:TRTBModule;override;
|
|
destructor Destroy;override;
|
|
end;
|
|
public
|
|
constructor Create();
|
|
function GenNewSrc():TRTBSource;override;
|
|
end;
|
|
|
|
const
|
|
cLuaLangName='Lua';
|
|
|
|
implementation
|
|
|
|
uses System.SysUtils;
|
|
|
|
const
|
|
cCurLang=cLuaLangName;
|
|
|
|
{constructor TRTBLuaCompiler.TRTBLuaSource.TRTBLuaFunc.Create(p:Pointer;sb:NativeUInt);
|
|
begin
|
|
Self.p:=VirtualAlloc(nil,sb,MEM_COMMIT ,PAGE_EXECUTE_READWRITE);
|
|
CopyMemory(Self.p,p,sb);
|
|
Self.sb:=sb;
|
|
FreeMem(p);
|
|
end;
|
|
|
|
function TRTBLuaCompiler.TRTBLuaSource.TRTBLuaFunc.Call(OutType:PTypeInfo;args:TArray<TValue>;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;
|
|
begin
|
|
end;
|
|
|
|
destructor TRTBLuaCompiler.TRTBLuaSource.TRTBLuaFunc.Destroy;
|
|
begin
|
|
VirtualFree(p,sb,MEM_RELEASE);
|
|
p:=nil;
|
|
end;
|
|
|
|
constructor TRTBLuaCompiler.TRTBLuaSource.TRTBLuaLib.TRTBLuaLibFunc.Create(p:Pointer);
|
|
begin
|
|
Self.p:=p;
|
|
end;
|
|
|
|
destructor TRTBLuaCompiler.TRTBLuaSource.TRTBLuaLib.TRTBLuaLibFunc.Destroy;
|
|
begin
|
|
p:=nil;
|
|
end;
|
|
|
|
function TRTBLuaCompiler.TRTBLuaSource.TRTBLuaLib.GetFuntion(Name:string):TRTBFunc;
|
|
begin
|
|
Result:=TRTBLuaLibFunc.Create(GetProcAddress(Lib,pwidechar(Name)));
|
|
end;
|
|
|
|
constructor TRTBLuaCompiler.TRTBLuaSource.TRTBLuaLib.Create(Name:string);
|
|
begin
|
|
filename:=Name;
|
|
Lib:=LoadLibrary(pwidechar(Name));
|
|
end;
|
|
|
|
destructor TRTBLuaCompiler.TRTBLuaSource.TRTBLuaLib.Destroy;
|
|
begin
|
|
FreeLibrary(Lib);
|
|
end;}
|
|
|
|
constructor TRTBLuaCompiler.TRTBLuaSource.TRTBLuaModule.TRTBLuaFunc.Create(Module:TRTBLuaModule;s:string);
|
|
begin
|
|
Name:=s;
|
|
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
|
|
TRTBLuaSource.AddToStack(State,i);
|
|
lua_call(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;
|
|
end;
|
|
|
|
destructor TRTBLuaCompiler.TRTBLuaSource.TRTBLuaModule.Destroy;
|
|
begin
|
|
lua_close(State);
|
|
end;
|
|
|
|
function TRTBLuaCompiler.TRTBLuaSource.GetText:string;
|
|
begin
|
|
Result:=FText;
|
|
end;
|
|
|
|
procedure TRTBLuaCompiler.TRTBLuaSource.SetText(const S:string);
|
|
begin
|
|
FText:=S;
|
|
end;
|
|
|
|
class procedure TRTBLuaCompiler.TRTBLuaSource.AddToStack(State:Plua_State;Data:TValue);
|
|
var
|
|
i:NativeUInt;
|
|
rtype:TRTTIType;
|
|
begin
|
|
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(String(AsType<ShortString>)))
|
|
else if IsType<WideString> then
|
|
lua_pushstring(State,PAnsiChar(AsType<WideString>))
|
|
else if IsType<UCS4String> then
|
|
lua_pushstring(State,PAnsiChar(AsType<UCS4String>))
|
|
else if IsOrdinal then
|
|
lua_pushinteger(State,Data.AsOrdinal)
|
|
else if IsType<Single> then
|
|
lua_pushnumber(State,AsType<Single>)
|
|
else if IsType<Double> then
|
|
lua_pushnumber(State,AsType<Double>)
|
|
else if IsType<Extended> then
|
|
lua_pushnumber(State,AsExtended)
|
|
else if IsType<Real> then
|
|
lua_pushnumber(State,AsExtended)
|
|
else if IsType<Real48> then
|
|
lua_pushnumber(State,AsType<Real48>)
|
|
else if IsType<Comp> then
|
|
lua_pushnumber(State,AsType<Comp>)
|
|
else if IsType<Currency> then
|
|
lua_pushnumber(State,AsType<Currency>)
|
|
else if Kind=tkPointer then
|
|
lua_pushlightuserdata(State,AsType<Pointer>)
|
|
else if IsArray then
|
|
begin
|
|
lua_createtable(State,Data.GetArrayLength,0);
|
|
for i:=0 to Data.GetArrayLength-1 do
|
|
begin
|
|
lua_pushinteger(State,i);
|
|
AddToStack(State,Data.GetArrayElement(i));
|
|
lua_settable(State,-3);
|
|
end;
|
|
end
|
|
else if Data.Kind=tkRecord then
|
|
begin
|
|
rtype:=TRTTIContext.Create.GetType(Data.TypeInfo);
|
|
end
|
|
//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;
|
|
|
|
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
|
|
i:NativeUInt;
|
|
p0:PByte;
|
|
begin
|
|
if Value.IsType<AnsiString> or Value.IsType<RawByteString> or Value.IsType<UTF8String> then
|
|
begin
|
|
PreDecl:=PreDecl+Key+' db '+#39+Value.AsType<AnsiString>+#39+',0'+sLineBreak;
|
|
inc(base,length(Value.AsType<AnsiString>));
|
|
end
|
|
else if Value.IsType<ShortString> then
|
|
begin
|
|
PreDecl:=PreDecl+Key+' db '+#39+Value.AsType<ShortString>+#39+',0'+sLineBreak;
|
|
inc(base,length(Value.AsType<ShortString>));
|
|
end
|
|
else if Value.IsType<WideString> then
|
|
begin
|
|
PreDecl:=PreDecl+Key+' db ';
|
|
p0:=Pointer(PWideChar(Value.AsType<WideString>));
|
|
for i:={$IFDEF NEXTGEN}0{$ELSE}1{$ENDIF} to length(Value.AsType<WideString>){$IFDEF NEXTGEN}-1{$ENDIF} do
|
|
begin
|
|
PreDecl:=PreDecl+inttostr(p0^)+',';
|
|
inc(p0);
|
|
PreDecl:=PreDecl+inttostr(p0^)+',';
|
|
inc(p0);
|
|
end;
|
|
PreDecl:=PreDecl+'0,0'+sLineBreak;
|
|
inc(base,length(Value.AsType<WideString>)*2);
|
|
end
|
|
else if Value.IsType<UCS4String> then
|
|
begin
|
|
PreDecl:=PreDecl+Key+' db ';
|
|
p0:=Pointer(PWideChar(Value.AsType<UCS4String>));
|
|
for i:={$IFDEF NEXTGEN}0{$ELSE}1{$ENDIF} to length(Value.AsType<UCS4String>){$IFDEF NEXTGEN}-1{$ENDIF} do
|
|
begin
|
|
PreDecl:=PreDecl+inttostr(p0^)+',';
|
|
inc(p0);
|
|
PreDecl:=PreDecl+inttostr(p0^)+',';
|
|
inc(p0);
|
|
PreDecl:=PreDecl+inttostr(p0^)+',';
|
|
inc(p0);
|
|
PreDecl:=PreDecl+inttostr(p0^)+',';
|
|
inc(p0);
|
|
end;
|
|
PreDecl:=PreDecl+'0,0,0,0'+sLineBreak;
|
|
inc(base,length(Value.AsType<UCS4String>)*4);
|
|
end
|
|
else if Value.IsOrdinal then
|
|
PreDecl:=PreDecl+Key+' equ '+Value.AsOrdinal.ToString+sLineBreak
|
|
else if Value.Kind=tkFloat then
|
|
begin
|
|
if Value.IsType<Single> then
|
|
PreDecl:=PreDecl+Key+' equ '+FloatToStrF(Value.AsType<Single>,ffFixed,1000,1000)+sLineBreak
|
|
else if Value.IsType<Double> then
|
|
PreDecl:=PreDecl+Key+' equ '+FloatToStrF(Value.AsType<Double>,ffFixed,1000,1000)+sLineBreak
|
|
else if Value.IsType<Extended> then
|
|
PreDecl:=PreDecl+Key+' equ '+FloatToStrF(Value.AsType<Extended>,ffFixed,1000,1000)+sLineBreak
|
|
else if Value.IsType<Real> then
|
|
PreDecl:=PreDecl+Key+' equ '+FloatToStrF(Value.AsType<Real>,ffFixed,1000,1000)+sLineBreak
|
|
else if Value.IsType<Real48> then
|
|
PreDecl:=PreDecl+Key+' equ '+FloatToStrF(Value.AsType<Real48>,ffFixed,1000,1000)+sLineBreak
|
|
else if Value.IsType<Comp> then
|
|
PreDecl:=PreDecl+Key+' equ '+FloatToStrF(Value.AsType<Comp>,ffFixed,1000,1000)+sLineBreak
|
|
else if Value.IsType<Currency> then
|
|
PreDecl:=PreDecl+Key+' equ '+FloatToStrF(Value.AsType<Currency>,ffFixed,1000,1000)+sLineBreak
|
|
else
|
|
PreDecl:=PreDecl+Key+' equ 0.0'+sLineBreak;
|
|
end
|
|
else if Value.Kind=tkPointer then
|
|
PreDecl:=PreDecl+Key+' equ '+NativeUInt(Value.AsType<Pointer>).ToString+sLineBreak
|
|
else if Value.IsArray then
|
|
begin
|
|
if Value.GetArrayLength=0 then
|
|
begin
|
|
PreDecl:=PreDecl+Key+' equ 0'+sLineBreak;
|
|
end
|
|
else
|
|
begin
|
|
PreDecl:=PreDecl+Key+':'+sLineBreak;
|
|
for i:=0 to Value.GetArrayLength-1 do
|
|
//VarParse(key+'.i'+i.ToString,Value.GetArrayElement(i),PreDecl,Base);
|
|
end;
|
|
end
|
|
else //if Value.Kind=tkUnknown then
|
|
PreDecl:=PreDecl+Key+' equ 0'+sLineBreak;
|
|
end;
|
|
var
|
|
s,PreDecl:string;
|
|
i,sb:NativeUInt;
|
|
RegVarDict:TDictionary<string,TPair<NativeUInt,PTypeInfo>>;
|
|
p:pointer;
|
|
State:Plua_State;
|
|
begin
|
|
PreDecl:='';
|
|
for s in libs do
|
|
PreDecl:=PreDecl+'local '+s+'=require("'+s+'")';
|
|
{RegVarDict:=TDictionary<string,TPair<NativeUInt,PTypeInfo>>.Create();
|
|
with regvars do
|
|
if Count<>0 then
|
|
for i:=0 to Count-1 do
|
|
begin
|
|
PreDecl:=PreDecl+pointerDecl+Items[i].Key+sLineBreak;
|
|
RegVarDict.Add(Items[i].Key,TPair<NativeUInt,PTypeInfo>.Create(base,Items[i].Value));
|
|
inc(base,SizeOf(pointer));
|
|
end;
|
|
with consts do
|
|
if Count<>0 then
|
|
for i:=0 to Count-1 do
|
|
with Items[i] do
|
|
ConstParse(Key,Value,PreDecl,base);}
|
|
State:=luaL_newstate();
|
|
if State=nil then
|
|
ERTBError.Create(RTBBuildError,cCurLang,self);
|
|
luaL_openlibs(State);
|
|
luaL_loadbuffer(State,PAnsiChar(FText),length(s),'code');
|
|
Result:=TRTBLuaModule.Create(State);
|
|
end;
|
|
|
|
destructor TRTBLuaCompiler.TRTBLuaSource.Destroy;
|
|
begin
|
|
FreeAndNil(libs);
|
|
FreeAndNil(funcs);
|
|
FreeAndNil(regvars);
|
|
FreeAndNil(consts);
|
|
end;
|
|
|
|
constructor TRTBLuaCompiler.Create();
|
|
begin
|
|
inherited Create();
|
|
end;
|
|
|
|
function TRTBLuaCompiler.GenNewSrc():TRTBSource;
|
|
begin
|
|
Result:=TRTBLuaSource.Create(Self);
|
|
end;
|
|
|
|
end.
|