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

Update

Browse Source
This commit is contained in:
Artem3213212
2018-06-20 17:24:04 +03:00
parent 242eeead08
commit 35cb759f40
6 changed files with 574 additions and 385 deletions
Download Patch File Download Diff File Expand all files Collapse all files

134
Source/RuntimeBuilder.Fasm.pas
View File

@@ -49,36 +49,37 @@ type
funcs:TStringList;
regvars:TList<TPair<string,PTypeInfo>>;
consts:TList<TPair<string,TValue>>;
callbacks:TList<TPair<string,TRTBCallBack>>;
FText:string;
function GetIncLibs():string;
function GetText:string;override;
procedure SetText(S:string);override;
procedure SetText(const S:string);override;
public
constructor Create(Compiler:TRTBFasmCompiler);
procedure LoadLib(Name:string);override;
procedure UnLoadLib(Name:string);override;
procedure LoadLib(const Name:string);override;
procedure UnLoadLib(const Name:string);override;
procedure AddNameSpace(Name:string);override;
procedure DelNameSpace(Name:string);override;
procedure AddNameSpace(const Name:string);override;
procedure DelNameSpace(const Name:string);override;
procedure AddType(NameSpace:string;Name:string;&Type:TRTBType);override;//-
procedure DelType(NameSpace:string;Name:string);override;//-
procedure AddType(const NameSpace,Name:string;&Type:TRTBType);override;//-
procedure DelType(const NameSpace,Name:string);override;//-
procedure AddConst(NameSpace:string;Name:string;Val:TValue);override;
procedure DelConst(NameSpace:string;Name:string);override;
procedure AddConst(const NameSpace,Name:string;Val:TValue);override;
procedure DelConst(const NameSpace,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 AddVariable(const NameSpace,Name:string;var Data);override;
procedure ExportVariable(const NameSpace,Name:string;var Data);override;
procedure DelVariable(const NameSpace,Name:string);override;
procedure AddCallBack(NameSpace:string;Name:string;CallBack:TRTBCallBack);override;//-
procedure DelCallBack(NameSpace:string;Name:string);override;//-
procedure AddCallBack(const NameSpace,Name:string;CallBack:TRTBCallBack);override;
procedure DelCallBack(const NameSpace,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;
function Compilate:TRTBModule;override;
destructor Destroy;override;
@@ -94,6 +95,15 @@ implementation
uses System.SysUtils;
function CallBackCall(callbacks:TList<TPair<string,TRTBCallBack>>;n:NativeUInt;p:pointer):pointer;stdcall;
begin
with callbacks[n].Value([p])do
begin
Result:=GetMemory(DataSize);
ExtractRawData(Result);
end;
end;
constructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmModule.TRTBFasmFunc.Create(p:Pointer);
begin
inherited Create();
@@ -180,7 +190,7 @@ begin
Result:=FText;
end;
procedure TRTBFasmCompiler.TRTBFasmSource.SetText(S:string);
procedure TRTBFasmCompiler.TRTBFasmSource.SetText(const S:string);
begin
FText:=S;
end;
@@ -193,35 +203,37 @@ libs:=TStringList.Create;
funcs:=TStringList.Create;
regvars:=TList<TPair<string,PTypeInfo>>.Create;
consts:=TList<TPair<string,TValue>>.Create;
callbacks:=TList<TPair<string,TRTBCallBack>>.Create;
end;
procedure TRTBFasmCompiler.TRTBFasmSource.LoadLib(Name:string);
procedure TRTBFasmCompiler.TRTBFasmSource.LoadLib(const Name:string);
begin
libs.Add(Name);
end;
procedure TRTBFasmCompiler.TRTBFasmSource.UnLoadLib(Name:string);
procedure TRTBFasmCompiler.TRTBFasmSource.UnLoadLib(const Name:string);
begin
with libs do
Delete(IndexOf(Name));
end;
procedure TRTBFasmCompiler.TRTBFasmSource.AddNameSpace(Name:string);
procedure TRTBFasmCompiler.TRTBFasmSource.AddNameSpace(const Name:string);
begin
end;
procedure TRTBFasmCompiler.TRTBFasmSource.DelNameSpace(Name:string);
procedure TRTBFasmCompiler.TRTBFasmSource.DelNameSpace(const Name:string);
label
funcscontinue,regvarscontinue,constscontinue;
var
i,i0:NativeUInt;
tName:string;
begin
Name:=Name+'.';
tName:=Name+'.';
i:=0;
while i<funcs.Count do
begin
for i0:=1 to length(Name) do
if funcs.Strings[i][i0]=Name[i0]then
for i0:=1 to length(tName) do
if funcs.Strings[i][i0]=tName[i0]then
goto funcscontinue;
funcs.Delete(i);
inc(i);
@@ -230,8 +242,8 @@ 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
for i0:=1 to length(tName) do
if regvars.Items[i].Key[i0]=tName[i0]then
goto regvarscontinue;
regvars.Delete(i);
inc(i);
@@ -240,8 +252,8 @@ 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
for i0:=1 to length(tName) do
if consts.Items[i].Key[i0]=tName[i0]then
goto constscontinue;
consts.Delete(i);
inc(i);
@@ -249,15 +261,15 @@ begin
end;
end;
procedure TRTBFasmCompiler.TRTBFasmSource.AddType(NameSpace:string;Name:string;&Type:TRTBType);
procedure TRTBFasmCompiler.TRTBFasmSource.AddType(const NameSpace,Name:string;&Type:TRTBType);
begin
end;
procedure TRTBFasmCompiler.TRTBFasmSource.DelType(NameSpace:string;Name:string);
procedure TRTBFasmCompiler.TRTBFasmSource.DelType(const NameSpace,Name:string);
begin
end;
procedure TRTBFasmCompiler.TRTBFasmSource.AddConst(NameSpace:string;Name:string;Val:TValue);
procedure TRTBFasmCompiler.TRTBFasmSource.AddConst(const NameSpace,Name:string;Val:TValue);
begin
if NameSpace<>'' then
consts.Add(TPair<string,TValue>.Create(NameSpace+'.'+Name,Val))
@@ -265,22 +277,20 @@ else
consts.Add(TPair<string,TValue>.Create(Name,Val));
end;
procedure TRTBFasmCompiler.TRTBFasmSource.DelConst(NameSpace:string;Name:string);
procedure TRTBFasmCompiler.TRTBFasmSource.DelConst(const NameSpace,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
if(consts.Items[i].Key=NameSpace+'.'+Name)or(consts.Items[i].Key=Name)then
begin
consts.Delete(i);
Break;
end;
end;
procedure TRTBFasmCompiler.TRTBFasmSource.AddVariable(NameSpace:string;Name:string;var Data);
procedure TRTBFasmCompiler.TRTBFasmSource.AddVariable(const NameSpace,Name:string;var Data);
begin
if NameSpace<>'' then
consts.Add(TPair<string,TValue>.Create(NameSpace+'.'+Name,addr(Data)))
@@ -288,7 +298,7 @@ else
consts.Add(TPair<string,TValue>.Create(Name,addr(Data)));
end;
procedure TRTBFasmCompiler.TRTBFasmSource.ExportVariable(NameSpace:string;Name:string;var Data);
procedure TRTBFasmCompiler.TRTBFasmSource.ExportVariable(const NameSpace,Name:string;var Data);
begin
if NameSpace<>'' then
consts.Add(TPair<string,TValue>.Create(NameSpace+'.'+Name,Addr(Data)))
@@ -296,20 +306,33 @@ else
consts.Add(TPair<string,TValue>.Create(Name,Addr(Data)));
end;
procedure TRTBFasmCompiler.TRTBFasmSource.DelVariable(NameSpace:string;Name:string);
procedure TRTBFasmCompiler.TRTBFasmSource.DelVariable(const NameSpace,Name:string);
begin
DelConst(NameSpace,Name);
end;
procedure TRTBFasmCompiler.TRTBFasmSource.AddCallBack(NameSpace:string;Name:string;CallBack:TRTBCallBack);
procedure TRTBFasmCompiler.TRTBFasmSource.AddCallBack(const NameSpace,Name:string;CallBack:TRTBCallBack);
begin
if NameSpace<>'' then
callbacks.Add(TPair<string,TRTBCallBack>.Create(NameSpace+'.'+Name,CallBack))
else
callbacks.Add(TPair<string,TRTBCallBack>.Create(Name,CallBack));
end;
procedure TRTBFasmCompiler.TRTBFasmSource.DelCallBack(NameSpace:string;Name:string);
procedure TRTBFasmCompiler.TRTBFasmSource.DelCallBack(const NameSpace,Name:string);
var
i:NativeUInt;
begin
if callbacks.Count<>0 then
for i:=0 to callbacks.Count-1 do
if(callbacks.Items[i].Key=NameSpace+'.'+Name)or(callbacks.Items[i].Key=Name)then
begin
callbacks.Delete(i);
Break;
end;
end;
procedure TRTBFasmCompiler.TRTBFasmSource.&Register(NameSpace:string;Name:string;&Type:TRTBType);
procedure TRTBFasmCompiler.TRTBFasmSource.&Register(const NameSpace,Name:string;&Type:TRTBType);
begin
if NameSpace<>'' then
regvars.Add(TPair<string,PTypeInfo>.Create(NameSpace+'.'+Name,&Type))
@@ -317,22 +340,20 @@ else
regvars.Add(TPair<string,PTypeInfo>.Create(Name,&Type));
end;
procedure TRTBFasmCompiler.TRTBFasmSource.UnRegister(NameSpace:string;Name:string);
procedure TRTBFasmCompiler.TRTBFasmSource.UnRegister(const NameSpace,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
if(regvars.Items[i].Key=Name)or(regvars.Items[i].Key=NameSpace+'.'+Name) then
begin
regvars.Delete(i);
Break;
end;
end;
procedure TRTBFasmCompiler.TRTBFasmSource.RegisterFunction(NameSpace:string;Name:string);
procedure TRTBFasmCompiler.TRTBFasmSource.RegisterFunction(const NameSpace,Name:string);
begin
if NameSpace<>'' then
funcs.Add(NameSpace+'.'+Name)
@@ -340,13 +361,14 @@ else
funcs.Add(Name);
end;
procedure TRTBFasmCompiler.TRTBFasmSource.UnRegisterFunction(NameSpace:string;Name:string);
procedure TRTBFasmCompiler.TRTBFasmSource.UnRegisterFunction(const NameSpace,Name:string);
begin
if NameSpace<>'' then
Name:=NameSpace+'.'+Name;
with funcs do
begin
Delete(IndexOf(NameSpace+'.'+Name));
Delete(IndexOf(Name));
end;
end;
function TRTBFasmCompiler.TRTBFasmSource.Compilate:TRTBModule;
procedure VarParse(key:string;value:TValue;var PreDecl:string;var base:NativeUInt);
@@ -547,7 +569,7 @@ case SizeOf(pointer)of
4:pointerDecl:='dd ';
8:pointerDecl:='dq ';
end;
PreDecl:='';
PreDecl:='use32'+sLineBreak;
FuncDict:=TDictionary<string,NativeUInt>.Create();
base:=0;
with funcs do
@@ -572,6 +594,14 @@ with consts do
for i:=0 to Count-1 do
with Items[i] do
ConstParse(Key,Value,PreDecl,base);
if callbacks.Count<>0 then
for i:=0 to callbacks.Count-1 do
PreDecl:=PreDecl+callbacks[i].Key+':'+sLineBreak+
{$IFDEF CPU32BITS}'pop eax'{$ELSE}'pop rax'{$ENDIF}+sLineBreak+
{$IFDEF CPU32BITS}'push dword '{$ELSE}'push qword '{$ENDIF}+i.ToString+sLineBreak+
{$IFDEF CPU32BITS}'push dword '{$ELSE}'push qword '{$ENDIF}+NativeUint(pointer(callbacks)).ToString+sLineBreak+
{$IFDEF CPU32BITS}'push eax'{$ELSE}'push rax'{$ENDIF}+sLineBreak+
{$IFDEF CPU32BITS}'jmp dword '{$ELSE}'jmp qword '{$ENDIF}+NativeUint(@CallBackCall).ToString+sLineBreak;
Res:=FasmAssemble('org '+NativeUInt(p).ToString+sLineBreak+PreDecl+Text+GetIncLibs,sb,(Compiler as TRTBFasmCompiler).MaxSteps);
if Res.Error<>FASM_OK then
begin

103
Source/RuntimeBuilder.Lua.pas
View File

@@ -15,13 +15,13 @@ type
protected type
TRTBLuaFunc=class(TRTBFunc)
protected
//p:Pointer;
Name:string;
public
//constructor Create(s:string);
//function Call(OutType:PTypeInfo;args:TArray<TValue>;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;override;
//destructor Destroy;override;
constructor Create(s:string);
function Call(OutType:PTypeInfo;args:TArray<TValue>;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;override;
destructor Destroy;override;
end;
TRTBFasmVar=class(TRTBVar)
TRTBLuaVar=class(TRTBVar)
protected
//p:pointer;
//&Type:TRTBType;
@@ -32,15 +32,14 @@ type
//destructor Destroy;override;
end;
private
//p:Pointer;
//sb:NativeUInt;
State:Plua_State;
//funcs:TDictionary<string,NativeUInt>;
//regvars:TDictionary<string,TPair<NativeUInt,PTypeInfo>>;
//function GetFuntion(Name:string):TRTBFunc;override;
function GetFuntion(Name:string):TRTBFunc;override;
//function GetVar(Name:string):TRTBVar;override;
public
//constructor Create(p:Pointer;sb:NativeUInt;funcs:TDictionary<string,NativeUInt>;regvars:TDictionary<string,TPair<NativeUInt,PTypeInfo>>);
//destructor Destroy;override;
constructor Create(AState:Plua_State);
destructor Destroy;override;
end;
protected
libs:TStringList;
@@ -50,12 +49,12 @@ type
FText:string;
//function GetIncLibs():string;
function GetText:string;override;
procedure SetText(S:string);override;
procedure SetText(const S:string);override;
public
constructor Create(Compiler:TRTBLuaCompiler);
procedure LoadLib(Name:string);override;
procedure UnLoadLib(Name:string);override;
procedure LoadLib(const Name:string);override;
procedure UnLoadLib(const Name:string);override;
//procedure AddNameSpace(Name:string);override;
//procedure DelNameSpace(Name:string);override;
@@ -86,10 +85,16 @@ type
function GenNewSrc():TRTBSource;override;
end;
const
cLuaLangName='Lua';
implementation
uses System.SysUtils;
const
cCurLang=cLuaLangName;
(*constructor TRTBLuaCompiler.TRTBLuaSource.TRTBLuaModule.TRTBLuaFunc.Create(p:Pointer);
begin
inherited Create();
@@ -361,37 +366,51 @@ begin
FreeLibrary(Lib);
end;*)
constructor TRTBLuaCompiler.TRTBLuaSource.TRTBLuaModule.TRTBLuaFunc.Create(s:string);
begin
Name:=s;
end;
function TRTBLuaCompiler.TRTBLuaSource.TRTBLuaModule.TRTBLuaFunc.Call(OutType:PTypeInfo;args:TArray<TValue>;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;
var
i:TValue;
begin
//for i in args do
// TRTBLuaCompiler.TRTBLuaSource.AddToStack();
end;
destructor TRTBLuaCompiler.TRTBLuaSource.TRTBLuaModule.TRTBLuaFunc.Destroy;
begin
end;
function TRTBLuaCompiler.TRTBLuaSource.TRTBLuaModule.GetFuntion(Name:string):TRTBFunc;
begin
//lua
//lua_getglobal();
//lua_call();
//Result:=TRTBLuaFunc.Create();
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(S:string);
procedure TRTBLuaCompiler.TRTBLuaSource.SetText(const S:string);
begin
FText:=S;
end;
{constructor TRTBLuaCompiler.TRTBLuaSource.Create(Compiler:TRTBLuaCompiler);
begin
inherited Create(Compiler);
FText:='';
end;
function TRTBLuaCompiler.TRTBLuaSource.CompilateAsFunc:TRTBFunc;
begin
//lua_(lua_tocfunction());
//(Compiler as TRTBLuaCompiler).Lua.RegisterFunction();
end;*)
{function TRTBLuaCompiler.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;}
constructor TRTBLuaCompiler.TRTBLuaSource.Create(Compiler:TRTBLuaCompiler);
begin
inherited Create(Compiler);
@@ -402,12 +421,12 @@ regvars:=TList<TPair<string,PTypeInfo>>.Create;
consts:=TList<TPair<string,TValue>>.Create;
end;
procedure TRTBLuaCompiler.TRTBLuaSource.LoadLib(Name:string);
procedure TRTBLuaCompiler.TRTBLuaSource.LoadLib(const Name:string);
begin
libs.Add(Name);
end;
procedure TRTBLuaCompiler.TRTBLuaSource.UnLoadLib(Name:string);
procedure TRTBLuaCompiler.TRTBLuaSource.UnLoadLib(const Name:string);
begin
with libs do
Delete(IndexOf(Name));
@@ -602,6 +621,7 @@ var
i,sb:NativeUInt;
RegVarDict:TDictionary<string,TPair<NativeUInt,PTypeInfo>>;
p:pointer;
State:Plua_State;
begin
PreDecl:='';
for s in libs do
@@ -620,8 +640,12 @@ with consts do
for i:=0 to Count-1 do
with Items[i] do
ConstParse(Key,Value,PreDecl,base);}
//Result:=TRTBLuaModule.Create(FText,funcs);
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;
@@ -635,7 +659,6 @@ end;
constructor TRTBLuaCompiler.Create();
begin
inherited Create();
//Lua:=luaL_newstate;
end;
function TRTBLuaCompiler.GenNewSrc():TRTBSource;

BIN
Source/RuntimeBuilder.pas
View File

Binary file not shown.