Add lua implementation
This commit is contained in:
@@ -3,7 +3,7 @@ unit RuntimeBuilder.Lua;
|
||||
interface
|
||||
|
||||
uses
|
||||
System.Classes,System.TypInfo,System.IOUtils,System.Rtti,Winapi.Windows,
|
||||
System.Classes,System.TypInfo,System.IOUtils,System.Rtti,Winapi.Windows,System.Generics.Collections,
|
||||
pLuaObject,pLuaRecord,pLuaTable,uWordList,Lua,LuaObject,LuaWrapper,pLua,RuntimeBuilder;
|
||||
|
||||
type
|
||||
@@ -11,46 +11,75 @@ type
|
||||
protected type
|
||||
TRTBLuaSource=class(TRTBSource)
|
||||
protected type
|
||||
{TRTBLuaFunc=class(TRTBFunc)
|
||||
protected
|
||||
p:Pointer;
|
||||
sb:NativeUInt;
|
||||
public
|
||||
constructor Create(p:Pointer;sb:NativeUInt);
|
||||
function Call(OutType:PTypeInfo;args:TArray<TValue>;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;override;
|
||||
destructor Destroy;override;
|
||||
end;
|
||||
TRTBLuaLib=class(TRTBLib)
|
||||
TRTBLuaModule=class(TRTBModule)
|
||||
private type
|
||||
TRTBLuaLibFunc=class(TRTBLuaFunc)
|
||||
TRTBLuaFunc=class(TRTBFunc)
|
||||
private
|
||||
//p:Pointer;
|
||||
public
|
||||
constructor Create(p:Pointer);
|
||||
destructor Destroy;override;
|
||||
//constructor Create(p:Pointer);
|
||||
//function Call(OutType:PTypeInfo;args:TArray<TValue>;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;override;
|
||||
//destructor Destroy;override;
|
||||
end;
|
||||
TRTBFasmVar=class(TRTBVar)
|
||||
protected
|
||||
//p:pointer;
|
||||
//&Type:TRTBType;
|
||||
//procedure SetVal(Val:TValue);override;
|
||||
//function GetVal:TValue;override;
|
||||
public
|
||||
//constructor Create(p:pointer;&Type:TRTBType);
|
||||
//destructor Destroy;override;
|
||||
end;
|
||||
private
|
||||
filename:string;
|
||||
Lib:NativeUInt;
|
||||
function GetFuntion(Name:string):TRTBFunc;override;
|
||||
//p:Pointer;
|
||||
//sb:NativeUInt;
|
||||
//funcs:TDictionary<string,NativeUInt>;
|
||||
//regvars:TDictionary<string,TPair<NativeUInt,PTypeInfo>>;
|
||||
//function GetFuntion(Name:string):TRTBFunc;override;
|
||||
//function GetVar(Name:string):TRTBVar;override;
|
||||
public
|
||||
constructor Create(Name:string);
|
||||
destructor Destroy;override;
|
||||
end;}
|
||||
protected
|
||||
FText:string;
|
||||
function GetText:string;override;
|
||||
procedure SetText(S:string);override;
|
||||
public
|
||||
constructor Create(Compiler:TRTBLuaCompiler);
|
||||
function CompilateAsFunc:TRTBFunc;override;
|
||||
//function CompilateAsLib:TRTBLib;override;
|
||||
//constructor Create(p:Pointer;sb:NativeUInt;funcs:TDictionary<string,NativeUInt>;regvars:TDictionary<string,TPair<NativeUInt,PTypeInfo>>);
|
||||
//destructor Destroy;override;
|
||||
end;
|
||||
protected
|
||||
Lua:Plua_state;
|
||||
//function GetIncLibs():string;
|
||||
public
|
||||
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(S:string);override;
|
||||
public
|
||||
constructor Create(Compiler:TRTBLuaCompiler);
|
||||
|
||||
procedure LoadLib(Name:string);override;
|
||||
procedure UnLoadLib(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 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(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;
|
||||
|
||||
function Compilate:TRTBModule;override;
|
||||
destructor Destroy;override;
|
||||
end;
|
||||
public
|
||||
constructor Create();
|
||||
//function LoadLib(Name:string):TRTBLib;
|
||||
function GenNewSrc():TRTBSource;override;
|
||||
end;
|
||||
|
||||
@@ -58,6 +87,233 @@ implementation
|
||||
|
||||
uses System.SysUtils;
|
||||
|
||||
(*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);
|
||||
@@ -122,20 +378,6 @@ function TRTBLuaCompiler.TRTBLuaSource.CompilateAsFunc:TRTBFunc;
|
||||
begin
|
||||
//lua_(lua_tocfunction());
|
||||
//(Compiler as TRTBLuaCompiler).Lua.RegisterFunction();
|
||||
end;
|
||||
|
||||
(*function TRTBLuaCompiler.TRTBLuaSource.CompilateAsLib:TRTBLib;
|
||||
var
|
||||
templib:string;
|
||||
Res:TLuaResult;
|
||||
begin
|
||||
templib:=TPath.GetTempFileName;
|
||||
Res:=LuaAssembleToFile({$IFDEF CPUX64}'format PE64 DLL'{$ELSE}'format PE DLL'{$ENDIF}+
|
||||
(Compiler as TRTBLuaCompiler).GetIncLibs+sLineBreak+Text,templib,
|
||||
(Compiler as TRTBLuaCompiler).CompilerMem,(Compiler as TRTBLuaCompiler).MaxSteps);
|
||||
if Res.Error<>Lua_OK then
|
||||
raise Exception.Create(Res.OutStr);
|
||||
Result:=TRTBLuaLib.Create(templib);
|
||||
end;*)
|
||||
|
||||
{function TRTBLuaCompiler.GetIncLibs():string;
|
||||
@@ -147,16 +389,258 @@ for i:=0 to libs.count-1 do
|
||||
Result:=Result+sLineBreak+'include '+#39+libs.Strings[i]+#39;
|
||||
end;}
|
||||
|
||||
constructor TRTBLuaCompiler.Create();
|
||||
constructor TRTBLuaCompiler.TRTBLuaSource.Create(Compiler:TRTBLuaCompiler);
|
||||
begin
|
||||
Lua:=luaL_newstate;
|
||||
inherited Create(Compiler);
|
||||
FText:='';
|
||||
libs:=TStringList.Create;
|
||||
funcs:=TStringList.Create;
|
||||
regvars:=TList<TPair<string,PTypeInfo>>.Create;
|
||||
consts:=TList<TPair<string,TValue>>.Create;
|
||||
end;
|
||||
|
||||
{function TRTBLuaCompiler.LoadLib(Name:string):TRTBLib;
|
||||
procedure TRTBLuaCompiler.TRTBLuaSource.LoadLib(Name:string);
|
||||
begin
|
||||
libs.Add(Name);
|
||||
end;}
|
||||
end;
|
||||
|
||||
procedure TRTBLuaCompiler.TRTBLuaSource.UnLoadLib(Name:string);
|
||||
begin
|
||||
with libs do
|
||||
Delete(IndexOf(Name));
|
||||
end;
|
||||
|
||||
function TRTBLuaCompiler.TRTBLuaSource.Compilate:TRTBModule;
|
||||
procedure VarParse(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
|
||||
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
|
||||
else if Value.Kind=tkFloat then
|
||||
begin
|
||||
if Value.IsType<Single> then
|
||||
PreDecl:=PreDecl+Key+' dd '+FloatToStrF(Value.AsType<Single>,ffFixed,1000,1000)+sLineBreak
|
||||
else if Value.IsType<Double> then
|
||||
PreDecl:=PreDecl+Key+' dq '+FloatToStrF(Value.AsType<Double>,ffFixed,1000,1000)+sLineBreak
|
||||
else if Value.IsType<Extended> then
|
||||
PreDecl:=PreDecl+Key+{$IF 8=SizeOf(Extended)}' dq '{$ELSEIF 10=SizeOf(Extended)}' dt '{$ELSE}' ddq '{$IFEND}+FloatToStrF(Value.AsType<Extended>,ffFixed,1000,1000)+sLineBreak
|
||||
else if Value.IsType<Real> then
|
||||
PreDecl:=PreDecl+Key+' dq '+FloatToStrF(Value.AsType<Real>,ffFixed,1000,1000)+sLineBreak
|
||||
else if Value.IsType<Real48> then
|
||||
PreDecl:=PreDecl+Key+' df '+FloatToStrF(Value.AsType<Real48>,ffFixed,1000,1000)+sLineBreak
|
||||
else if Value.IsType<Comp> then
|
||||
PreDecl:=PreDecl+Key+' dq '+FloatToStrF(Value.AsType<Comp>,ffFixed,1000,1000)+sLineBreak
|
||||
else if Value.IsType<Currency> then
|
||||
PreDecl:=PreDecl+Key+' dq '+FloatToStrF(Value.AsType<Currency>,ffFixed,1000,1000)+sLineBreak
|
||||
else
|
||||
PreDecl:=PreDecl+Key+' dd 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=tkRecord then
|
||||
begin
|
||||
PreDecl:=PreDecl+Key+':'+sLineBreak;
|
||||
for i:=1 to Value.TypeData.ManagedFldCount do
|
||||
|
||||
end}
|
||||
else //if Value.Kind=tkUnknown then
|
||||
PreDecl:=PreDecl+Key+': times '+ Value.DataSize.ToString+' db 0'+sLineBreak;
|
||||
end;
|
||||
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
|
||||
templib,PreDecl:string;
|
||||
i,sb:NativeUInt;
|
||||
FuncDict:TDictionary<string,NativeUInt>;
|
||||
RegVarDict:TDictionary<string,TPair<NativeUInt,PTypeInfo>>;
|
||||
p:pointer;
|
||||
begin
|
||||
//FuncDict:=TDictionary<string,NativeUInt>.Create();
|
||||
with funcs do
|
||||
if Count<>0 then
|
||||
for i:=0 to Count-1 do
|
||||
begin
|
||||
PreDecl:=PreDecl+Strings[i]+sLineBreak;
|
||||
FuncDict.Add(Strings[i],base);
|
||||
inc(base,SizeOf(pointer));
|
||||
end;
|
||||
{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);}
|
||||
|
||||
//Result:=TRTBFasmModule.Create(p,Res.sb,FuncDict,RegVarDict);
|
||||
end;
|
||||
|
||||
destructor TRTBLuaCompiler.TRTBLuaSource.Destroy;
|
||||
begin
|
||||
FreeAndNil(libs);
|
||||
FreeAndNil(funcs);
|
||||
FreeAndNil(regvars);
|
||||
FreeAndNil(consts);
|
||||
end;
|
||||
|
||||
constructor TRTBLuaCompiler.Create();
|
||||
begin
|
||||
inherited Create();
|
||||
//Lua:=luaL_newstate;
|
||||
end;
|
||||
|
||||
function TRTBLuaCompiler.GenNewSrc():TRTBSource;
|
||||
begin
|
||||
|
||||
@@ -59,19 +59,19 @@ type
|
||||
procedure AddNameSpace(Name:string);virtual;abstract;
|
||||
procedure DelNameSpace(Name:string);virtual;abstract;
|
||||
|
||||
procedure AddType(NameSpace:string;Name:string;&Type:TRTBType);virtual;abstract;
|
||||
procedure AddType(NameSpace:string;Name:string;&Type:TRTBType);virtual;abstract;//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD>
|
||||
procedure DelType(NameSpace:string;Name:string);virtual;abstract;
|
||||
|
||||
procedure AddConst(NameSpace:string;Name:string;Val:TValue);virtual;abstract;
|
||||
procedure AddConst(NameSpace:string;Name:string;Val:TValue);virtual;abstract;//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||||
procedure DelConst(NameSpace:string;Name:string);virtual;abstract;
|
||||
|
||||
procedure AddVariable(NameSpace:string;Name:string;var Data);virtual;abstract;
|
||||
procedure ExportVariable(NameSpace:string;Name:string;var Data);virtual;abstract;
|
||||
procedure AddVariable(NameSpace:string;Name:string;var Data);virtual;abstract;//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>,<2C><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||||
procedure ExportVariable(NameSpace:string;Name:string;var Data);virtual;abstract;//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>,<2C><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> Data
|
||||
procedure DelVariable(NameSpace:string;Name:string);virtual;abstract;
|
||||
|
||||
procedure &Register(NameSpace:string;Name:string;&Type:TRTBType);virtual;abstract;
|
||||
procedure &Register(NameSpace:string;Name:string;&Type:TRTBType);virtual;abstract;//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||||
procedure UnRegister(NameSpace:string;Name:string);virtual;abstract;
|
||||
procedure &RegisterFunction(NameSpace:string;Name:string);virtual;abstract;
|
||||
procedure &RegisterFunction(NameSpace:string;Name:string);virtual;abstract;//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||||
procedure UnRegisterFunction(NameSpace:string;Name:string);virtual;abstract;
|
||||
|
||||
function Compilate:TRTBModule;virtual;abstract;
|
||||
|
||||
@@ -15,7 +15,7 @@ uses
|
||||
RuntimeBuilder in '..\Source\RuntimeBuilder.pas',
|
||||
RuntimeBuilder.Fasm in '..\Source\RuntimeBuilder.Fasm.pas',
|
||||
FasmOnDelphi in '..\lib\FasmOnDelphi\Source\FasmOnDelphi.pas',
|
||||
Fasm4Delphi in '..\lib\FasmOnDelphi\Fasm4Delphi\Source\Fasm4Delphi.pas'{,
|
||||
Fasm4Delphi in '..\lib\FasmOnDelphi\Fasm4Delphi\Source\Fasm4Delphi.pas',
|
||||
RuntimeBuilder.Lua in '..\Source\RuntimeBuilder.Lua.pas',
|
||||
pLuaObject in '..\lib\pLua-XE\src\pLuaObject.pas',
|
||||
pLuaRecord in '..\lib\pLua-XE\src\pLuaRecord.pas',
|
||||
@@ -24,7 +24,7 @@ uses
|
||||
Lua in '..\lib\pLua-XE\src\Lua.pas',
|
||||
LuaObject in '..\lib\pLua-XE\src\LuaObject.pas',
|
||||
LuaWrapper in '..\lib\pLua-XE\src\LuaWrapper.pas',
|
||||
pLua in '..\lib\pLua-XE\src\pLua.pas'{};
|
||||
pLua in '..\lib\pLua-XE\src\pLua.pas';
|
||||
|
||||
var
|
||||
runner : ITestRunner;
|
||||
|
||||
@@ -109,8 +109,26 @@
|
||||
Lua in '..\lib\pLua-XE\src\Lua.pas',
|
||||
LuaObject in '..\lib\pLua-XE\src\LuaObject.pas',
|
||||
LuaWrapper in '..\lib\pLua-XE\src\LuaWrapper.pas',
|
||||
pLua in '..\lib\pLua-XE\src\pLua.pas'{</Form>
|
||||
pLua in '..\lib\pLua-XE\src\pLua.pas';
|
||||
|
||||
var
|
||||
runner</Form>
|
||||
<DesignClass>ITestRunner;
|
||||
results : IRunResults;
|
||||
logger : ITestLogger;
|
||||
nunitLogger : ITestLogger;
|
||||
begin
|
||||
{$IFDEF TESTINSIGHT</DesignClass>
|
||||
</DCCReference>
|
||||
<DCCReference Include="..\Source\RuntimeBuilder.Lua.pas"/>
|
||||
<DCCReference Include="..\lib\pLua-XE\src\pLuaObject.pas"/>
|
||||
<DCCReference Include="..\lib\pLua-XE\src\pLuaRecord.pas"/>
|
||||
<DCCReference Include="..\lib\pLua-XE\src\pLuaTable.pas"/>
|
||||
<DCCReference Include="..\lib\pLua-XE\src\uWordList.pas"/>
|
||||
<DCCReference Include="..\lib\pLua-XE\src\Lua.pas"/>
|
||||
<DCCReference Include="..\lib\pLua-XE\src\LuaObject.pas"/>
|
||||
<DCCReference Include="..\lib\pLua-XE\src\LuaWrapper.pas"/>
|
||||
<DCCReference Include="..\lib\pLua-XE\src\pLua.pas"/>
|
||||
<BuildConfiguration Include="Release">
|
||||
<Key>Cfg_2</Key>
|
||||
<CfgParent>Base</CfgParent>
|
||||
@@ -467,13 +485,13 @@
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
|
||||
<ProjectRoot Platform="OSX32" Name="$(PROJECTNAME)"/>
|
||||
<ProjectRoot Platform="Android" Name="$(PROJECTNAME)"/>
|
||||
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
|
||||
<ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/>
|
||||
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
|
||||
<ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>
|
||||
<ProjectRoot Platform="OSX32" Name="$(PROJECTNAME)"/>
|
||||
<ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
|
||||
</Deployment>
|
||||
<Platforms>
|
||||
<Platform value="OSX32">False</Platform>
|
||||
|
||||
@@ -3,21 +3,21 @@ unit Unit1;
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,DUnitX.TestFramework,RuntimeBuilder,RuntimeBuilder.Fasm;
|
||||
System.SysUtils,DUnitX.TestFramework,RuntimeBuilder,RuntimeBuilder.Fasm,RuntimeBuilder.Lua;
|
||||
|
||||
type
|
||||
[TestFixture]
|
||||
TRuntimeBuilderTestObject=class(TObject)
|
||||
public
|
||||
[TestCase]
|
||||
procedure Test1();
|
||||
procedure FasmTest();
|
||||
[TestCase]
|
||||
procedure Test2();
|
||||
procedure LuaTest();
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
procedure TRuntimeBuilderTestObject.Test1();
|
||||
procedure TRuntimeBuilderTestObject.FasmTest();
|
||||
var
|
||||
Fasm:TRTBFasmCompiler;
|
||||
Src:TRTBSource;
|
||||
@@ -36,18 +36,18 @@ Module:=Src.Compilate;
|
||||
Func1:=Module.Funtion['main'];
|
||||
Func2:=Module.Funtion['varmain'];
|
||||
if 454<>Func1.Call(TypeInfo(integer),[454],CRTBCallTypeStdCall).AsInteger then
|
||||
raise Exception.Create('Error in test1');
|
||||
raise Exception.Create('Error in FasmTest');
|
||||
Var1:=Module.&Var['Pmain'];
|
||||
Var1.Val:=424;
|
||||
if Var1.Val.AsInteger<>Func2.Call(TypeInfo(integer),[],CRTBCallTypeStdCall).AsInteger then
|
||||
raise Exception.Create('Error in test1');
|
||||
raise Exception.Create('Error in FasmTest');
|
||||
FreeAndNil(Var1);
|
||||
FreeAndNil(Func2);
|
||||
FreeAndNil(Func1);
|
||||
FreeAndNil(module);
|
||||
FreeAndNil(Src);
|
||||
FreeAndNil(Fasm);
|
||||
end;
|
||||
|
||||
procedure TRuntimeBuilderTestObject.Test2();
|
||||
var
|
||||
{var
|
||||
Fasm:TRTBFasmCompiler;
|
||||
Src:TRTBSource;
|
||||
Func1:TRTBFunc;
|
||||
@@ -67,6 +67,37 @@ FreeAndNil(Src);
|
||||
FreeAndNil(Fasm);}
|
||||
end;
|
||||
|
||||
procedure TRuntimeBuilderTestObject.LuaTest();
|
||||
var
|
||||
Lua:TRTBLuaCompiler;
|
||||
Src:TRTBSource;
|
||||
Module:TRTBModule;
|
||||
Func1,Func2:TRTBFunc;
|
||||
Var1:TRTBVar;
|
||||
begin
|
||||
Lua:=TRTBLuaCompiler.Create();
|
||||
Src:=Lua.GenNewSrc;
|
||||
Src.Text:='function main(n)'+sLineBreak+' return 1'+sLineBreak+'end';
|
||||
Src.RegisterFunction('','main');
|
||||
//Src.RegisterFunction('','varmain');
|
||||
//Src.Register('','Pmain',TypeInfo(integer));
|
||||
Module:=Src.Compilate;
|
||||
Func1:=Module.Funtion['main'];
|
||||
//Func2:=Module.Funtion['varmain'];
|
||||
if 454<>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(module);
|
||||
FreeAndNil(Src);
|
||||
FreeAndNil(Lua);
|
||||
end;
|
||||
|
||||
initialization
|
||||
TDUnitX.RegisterTestFixture(TRuntimeBuilderTestObject);
|
||||
end.
|
||||
|
||||
@@ -1,29 +0,0 @@
|
||||
entry DllEntryPoint
|
||||
|
||||
section '.text' code readable executable
|
||||
|
||||
proc DllEntryPoint hinstDLL,fdwReason,lpvReserved
|
||||
mov eax,TRUE
|
||||
ret
|
||||
endp
|
||||
|
||||
proc MyEcho HWnd
|
||||
mov eax,[HWnd]
|
||||
ret
|
||||
endp
|
||||
|
||||
dd GetLastError
|
||||
|
||||
section '.idata' import data readable writeable
|
||||
|
||||
library kernel,'KERNEL32.DLL'
|
||||
|
||||
import kernel,\
|
||||
GetLastError,'GetLastError'
|
||||
|
||||
section '.edata' export data readable
|
||||
|
||||
export '1.DLL',\
|
||||
MyEcho,'MyEcho'
|
||||
|
||||
section '.reloc' fixups data readable discardable
|
||||
Reference in New Issue
Block a user