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