API Update+Base FASM Support

This commit is contained in:
2018-04-12 16:35:32 +03:00
parent 08d7761837
commit 0e25c2e70f
5 changed files with 138 additions and 80 deletions

View File

@@ -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);

View File

@@ -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;