API Update+Base FASM Support
This commit is contained in:
2
.gitmodules
vendored
2
.gitmodules
vendored
@@ -1,5 +1,5 @@
|
||||
[submodule "FasmOnDelphi"]
|
||||
path = FasmOnDelphi
|
||||
path = lib/FasmOnDelphi
|
||||
url = git@git.teamfnd.ru:artem3213212/FasmOnDelphi.git
|
||||
[submodule "lib/pLua-XE"]
|
||||
path = lib/pLua-XE
|
||||
|
||||
@@ -5,7 +5,7 @@ interface
|
||||
//{$INLINE auto}
|
||||
|
||||
uses
|
||||
System.Classes,System.TypInfo,System.IOUtils,System.Rtti,Winapi.Windows,
|
||||
System.Classes,System.TypInfo,System.IOUtils,System.Rtti,System.Generics.Collections,Winapi.Windows,
|
||||
RuntimeBuilder,FasmOnDelphi;
|
||||
|
||||
type
|
||||
@@ -13,42 +13,68 @@ type
|
||||
protected type
|
||||
TRTBFasmSource=class(TRTBSource)
|
||||
protected type
|
||||
TRTBFasmFunc=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;
|
||||
TRTBFasmLib=class(TRTBLib)
|
||||
TRTBFasmModule=class(TRTBModule)
|
||||
private type
|
||||
TRTBFasmLibFunc=class(TRTBFasmFunc)
|
||||
TRTBFasmFunc=class(TRTBFunc)
|
||||
private
|
||||
p:Pointer;
|
||||
public
|
||||
constructor Create(p:Pointer);
|
||||
destructor Destroy;override;
|
||||
function Call(OutType:PTypeInfo;args:TArray<TValue>;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;override;
|
||||
end;
|
||||
{TRTBFasmVar=class(TRTBVar)
|
||||
protected
|
||||
function SetVal(Val:TValue);virtual;abstract;
|
||||
function GetVal:TValue;virtual;abstract;
|
||||
public
|
||||
property Val:TValue read GetVal write SetVal;
|
||||
end;}
|
||||
private
|
||||
filename:string;
|
||||
Lib:NativeUInt;
|
||||
p:Pointer;
|
||||
sb:NativeUInt;
|
||||
funcs:TDictionary<string,NativeUInt>;
|
||||
function GetFuntion(Name:string):TRTBFunc;override;
|
||||
{function GetVar(Name:string):TRTBVar;override;}
|
||||
public
|
||||
constructor Create(Name:string);
|
||||
constructor Create(p:Pointer;sb:NativeUInt;funcs:TDictionary<string,NativeUInt>);
|
||||
destructor Destroy;override;
|
||||
end;
|
||||
protected
|
||||
libs:TStringList;
|
||||
function GetIncLibs():string;
|
||||
protected
|
||||
funcs:TStringList;
|
||||
regvars:TList<TPair<string,PTypeInfo>>;
|
||||
FText:string;
|
||||
function GetIncLibs():string;
|
||||
function GetText:string;override;
|
||||
procedure SetText(S:string);override;
|
||||
public
|
||||
function LoadLib(Name:string):TRTBLib;override;
|
||||
constructor Create(Compiler:TRTBFasmCompiler);
|
||||
function CompilateAsFunc:TRTBFunc;override;
|
||||
function CompilateAsLib:TRTBLib;override;
|
||||
|
||||
{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 ExportType(NameSpace:string;Name:string;&Type:TRTBType);override;
|
||||
procedure DelType(NameSpace:string;Name:string);override;
|
||||
|
||||
procedure AddConst(NameSpace:string;Name:string;Val:TValue);override;
|
||||
procedure ExportConst(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;&Type:TRTBType);override;
|
||||
procedure RegisterFunction(NameSpace:string;Name:string);override;
|
||||
//procedure UnRegisterFunction(NameSpace:string;Name:string);override;
|
||||
|
||||
function Compilate:TRTBModule;override;
|
||||
destructor Destroy;override;
|
||||
end;
|
||||
public
|
||||
CompilerMem:NativeUInt;
|
||||
@@ -61,21 +87,19 @@ implementation
|
||||
|
||||
uses System.SysUtils;
|
||||
|
||||
constructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmFunc.Create(p:Pointer;sb:NativeUInt);
|
||||
constructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmModule.TRTBFasmFunc.Create(p:Pointer);
|
||||
begin
|
||||
Self.p:=VirtualAlloc(nil,sb,MEM_COMMIT ,PAGE_EXECUTE_READWRITE);
|
||||
CopyMemory(Self.p,p,sb);
|
||||
Self.sb:=sb;
|
||||
FreeMem(p);
|
||||
inherited Create();
|
||||
Self.p:=p;
|
||||
end;
|
||||
|
||||
function TRTBFasmCompiler.TRTBFasmSource.TRTBFasmFunc.Call(OutType:PTypeInfo;args:TArray<TValue>;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;
|
||||
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,CRTBCallTypeDefault:Result:=Invoke(p,args,ccReg,OutType);
|
||||
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);
|
||||
@@ -84,13 +108,7 @@ end;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
destructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmFunc.Destroy;
|
||||
begin
|
||||
VirtualFree(p,sb,MEM_RELEASE);
|
||||
p:=nil;
|
||||
end;
|
||||
|
||||
constructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmLib.TRTBFasmLibFunc.Create(p:Pointer);
|
||||
(*constructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmLib.TRTBFasmLibFunc.Create(p:Pointer);
|
||||
begin
|
||||
Self.p:=p;
|
||||
end;
|
||||
@@ -103,17 +121,35 @@ end;
|
||||
function TRTBFasmCompiler.TRTBFasmSource.TRTBFasmLib.GetFuntion(Name:string):TRTBFunc;
|
||||
begin
|
||||
Result:=TRTBFasmLibFunc.Create(GetProcAddress(Lib,pwidechar(Name)));
|
||||
end;*)
|
||||
|
||||
{$POINTERMATH ON}
|
||||
function TRTBFasmCompiler.TRTBFasmSource.TRTBFasmModule.GetFuntion(Name:string):TRTBFunc;
|
||||
begin
|
||||
Result:=TRTBFasmFunc.Create(Pointer(PNativeUInt(NativeUInt(funcs.Items[Name])+NativeUInt(p))^+NativeUInt(p)));
|
||||
end;
|
||||
|
||||
constructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmLib.Create(Name:string);
|
||||
constructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmModule.Create(p:Pointer;sb:NativeUInt;funcs:TDictionary<string,NativeUInt>);
|
||||
begin
|
||||
filename:=Name;
|
||||
Lib:=LoadLibrary(pwidechar(Name));
|
||||
Self.p:=VirtualAlloc(nil,sb,MEM_COMMIT,PAGE_EXECUTE_READWRITE);
|
||||
CopyMemory(Self.p,p,sb);
|
||||
Self.sb:=sb;
|
||||
Self.funcs:=funcs;
|
||||
FreeMem(p);
|
||||
end;
|
||||
|
||||
destructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmLib.Destroy;
|
||||
destructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmModule.Destroy;
|
||||
begin
|
||||
FreeLibrary(Lib);
|
||||
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;
|
||||
@@ -126,53 +162,72 @@ begin
|
||||
FText:=S;
|
||||
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;
|
||||
|
||||
constructor TRTBFasmCompiler.TRTBFasmSource.Create(Compiler:TRTBFasmCompiler);
|
||||
begin
|
||||
inherited Create(Compiler);
|
||||
FText:='';
|
||||
libs:=TStringList.Create;
|
||||
funcs:=TStringList.Create;
|
||||
end;
|
||||
|
||||
function TRTBFasmCompiler.TRTBFasmSource.LoadLib(Name:string):TRTBLib;
|
||||
{function TRTBFasmCompiler.TRTBFasmSource.LoadLib(Name:string):TRTBLib;
|
||||
begin
|
||||
libs.Add(Name);
|
||||
end;}
|
||||
|
||||
procedure TRTBFasmCompiler.TRTBFasmSource.&Register(NameSpace:string;Name:string;&Type:TRTBType);
|
||||
begin
|
||||
if NameSpace<>'' then
|
||||
&Register('',NameSpace+'.'+Name,&Type)
|
||||
else
|
||||
begin
|
||||
|
||||
//
|
||||
end;
|
||||
end;
|
||||
|
||||
function TRTBFasmCompiler.TRTBFasmSource.CompilateAsFunc:TRTBFunc;
|
||||
var
|
||||
Res:TFasmResult;
|
||||
procedure TRTBFasmCompiler.TRTBFasmSource.RegisterFunction(NameSpace:string;Name:string);
|
||||
begin
|
||||
Res:=FasmAssemble(Text+(Compiler as TRTBFasmCompiler).GetIncLibs,(Compiler as TRTBFasmCompiler).CompilerMem,(Compiler as TRTBFasmCompiler).MaxSteps);
|
||||
if Res.Error<>FASM_OK then
|
||||
raise Exception.Create(Res.OutStr);
|
||||
Result:=TRTBFasmFunc.Create(Res.OutData,Res.sb);
|
||||
if NameSpace<>'' then
|
||||
funcs.Add(NameSpace+'.'+Name)
|
||||
else
|
||||
funcs.Add(Name);
|
||||
end;
|
||||
|
||||
function TRTBFasmCompiler.TRTBFasmSource.CompilateAsLib:TRTBLib;
|
||||
function TRTBFasmCompiler.TRTBFasmSource.Compilate:TRTBModule;
|
||||
var
|
||||
templib:string;
|
||||
templib,pointerDecl,FuncDecl:string;
|
||||
Res:TFasmResult;
|
||||
i:NativeUInt;
|
||||
FuncDict:TDictionary<string,NativeUInt>;
|
||||
begin
|
||||
templib:=TPath.GetTempFileName;
|
||||
Res:=FasmAssembleToFile({$IFDEF CPUX64}'format PE64 DLL'{$ELSE}'format PE DLL'{$ENDIF}+
|
||||
(Compiler as TRTBFasmCompiler).GetIncLibs+sLineBreak+Text,templib,
|
||||
(Compiler as TRTBFasmCompiler).CompilerMem,(Compiler as TRTBFasmCompiler).MaxSteps);
|
||||
case SizeOf(pointer) of
|
||||
2:pointerDecl:='dw ';
|
||||
4:pointerDecl:='dd ';
|
||||
8:pointerDecl:='dq ';
|
||||
end;
|
||||
FuncDecl:='';
|
||||
FuncDict:=TDictionary<string,NativeUInt>.Create();
|
||||
for i:=0 to funcs.Count-1 do
|
||||
begin
|
||||
FuncDecl:=FuncDecl+pointerDecl+funcs.Strings[i]+sLineBreak;
|
||||
FuncDict.Add(funcs.Strings[i],i*SizeOf(pointer));
|
||||
end;
|
||||
Res:=FasmAssemble(FuncDecl+Text+GetIncLibs,(Compiler as TRTBFasmCompiler).CompilerMem,(Compiler as TRTBFasmCompiler).MaxSteps);
|
||||
if Res.Error<>FASM_OK then
|
||||
raise Exception.Create(Res.OutStr);
|
||||
Result:=TRTBFasmLib.Create(templib);
|
||||
Result:=TRTBFasmModule.Create(Res.OutData,Res.sb,FuncDict);
|
||||
end;
|
||||
|
||||
destructor TRTBFasmCompiler.TRTBFasmSource.Destroy;
|
||||
begin
|
||||
FreeAndNil(libs);
|
||||
FreeAndNil(funcs);
|
||||
end;
|
||||
|
||||
constructor TRTBFasmCompiler.Create(FasmPath:String=FasmPath;AsDll:boolean=false);
|
||||
begin
|
||||
inherited Create();
|
||||
CompilerMem:=1024*1024*16;
|
||||
MaxSteps:=65535;
|
||||
OpenFASM(FasmPath,AsDll);
|
||||
|
||||
@@ -6,7 +6,7 @@ uses
|
||||
System.TypInfo,System.Rtti;
|
||||
|
||||
const
|
||||
CRTBCallTypeNil=ccReg;
|
||||
CRTBCallTypeNil=ccStdCall;
|
||||
CRTBCallTypeRegister=ccReg;
|
||||
CRTBCallTypeStdCall=ccStdCall;
|
||||
CRTBCallTypeCdecl=ccCdecl;
|
||||
@@ -25,23 +25,24 @@ type
|
||||
|
||||
TRTBFunc=class abstract
|
||||
public
|
||||
function Call(Name:string;OutType:PTypeInfo;args:TArray<TValue>;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;virtual;abstract;
|
||||
function Call(OutType:PTypeInfo;args:TArray<TValue>;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;virtual;abstract;
|
||||
end;
|
||||
|
||||
TRTBVar=class abstract
|
||||
protected
|
||||
function SetVal(TValue);virtual;abstract;
|
||||
procedure SetVal(Val:TValue);virtual;abstract;
|
||||
function GetVal:TValue;virtual;abstract;
|
||||
public
|
||||
property Val:TValue read GetVal write SetVal;
|
||||
end;
|
||||
|
||||
TRTBLib=class abstract
|
||||
TRTBModule=class abstract
|
||||
protected
|
||||
function GetFuntion(Name:string):TRTBFunc;virtual;abstract;
|
||||
function GetVar(Name:string):TRTBVar;virtual;abstract;
|
||||
public
|
||||
property Funtion[Name:string]:TRTBFunc read GetFuntion;
|
||||
property &Var[Name:string]:TRTBVar read GetFuntion;
|
||||
property &Var[Name:string]:TRTBVar read GetVar;
|
||||
end;
|
||||
|
||||
TRTBSource=class abstract
|
||||
@@ -71,11 +72,13 @@ type
|
||||
procedure DelVariable(NameSpace:string;Name:string);virtual;abstract;
|
||||
|
||||
procedure &Register(NameSpace:string;Name:string;&Type:TRTBType);virtual;abstract;
|
||||
procedure UnRegister(NameSpace:string;Name:string;&Type:TRTBType);virtual;abstract;
|
||||
procedure &RegisterFunction(NameSpace:string;Name:string);virtual;abstract;
|
||||
procedure UnRegisterFunction(NameSpace:string;Name:string);virtual;abstract;
|
||||
|
||||
function Compilate:TRTBLib;virtual;abstract;
|
||||
procedure LoadFromFile(&File:string);
|
||||
procedure SaveToFile(&File:string);
|
||||
function Compilate:TRTBModule;virtual;abstract;
|
||||
procedure LoadFromFile(&File:string);virtual;
|
||||
procedure SaveToFile(&File:string);virtual;
|
||||
property Text:string read GetText write SetText;
|
||||
end;
|
||||
|
||||
|
||||
@@ -467,13 +467,13 @@
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
|
||||
<ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>
|
||||
<ProjectRoot Platform="Android" Name="$(PROJECTNAME)"/>
|
||||
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
|
||||
<ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/>
|
||||
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
|
||||
<ProjectRoot Platform="OSX32" Name="$(PROJECTNAME)"/>
|
||||
<ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>
|
||||
<ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
|
||||
</Deployment>
|
||||
<Platforms>
|
||||
<Platform value="OSX32">False</Platform>
|
||||
|
||||
@@ -23,24 +23,24 @@ var
|
||||
Src:TRTBSource;
|
||||
Func1:TRTBFunc;
|
||||
begin
|
||||
{Fasm:=TRTBFasmCompiler.Create('..\..\..\FasmOnDelphi\fasmw172\fasm');
|
||||
Fasm:=TRTBFasmCompiler.Create('..\..\..\lib\FasmOnDelphi\fasmw172\fasm');
|
||||
Src:=Fasm.GenNewSrc;
|
||||
Src.Text:='use32'+sLineBreak+'pop ecx'+sLineBreak+'pop eax'+sLineBreak+'jmp ecx';
|
||||
Func1:=src.CompilateAsFunc;
|
||||
Src.Text:='use32'+sLineBreak+'main:'+sLineBreak+'pop ecx'+sLineBreak+'pop eax'+sLineBreak+'jmp ecx';
|
||||
Src.RegisterFunction('','main');
|
||||
Func1:=src.Compilate.Funtion['main'];
|
||||
if 454<>Func1.Call(TypeInfo(integer),[454],CRTBCallTypeStdCall).AsInteger then
|
||||
begin
|
||||
raise Exception.Create('Error in test1');
|
||||
end;
|
||||
FreeAndNil(Func1);
|
||||
FreeAndNil(Src);
|
||||
FreeAndNil(Fasm);}
|
||||
FreeAndNil(Fasm);
|
||||
end;
|
||||
|
||||
procedure TRuntimeBuilderTestObject.Test2();
|
||||
var
|
||||
Fasm:TRTBFasmCompiler;
|
||||
Src:TRTBSource;
|
||||
lib:TRTBLib;
|
||||
Func1:TRTBFunc;
|
||||
begin
|
||||
{Fasm:=TRTBFasmCompiler.Create('..\..\..\FasmOnDelphi\fasmw172\fasm');
|
||||
|
||||
Reference in New Issue
Block a user