Files
RuntimeBuilder/Source/RuntimeBuilder.Fasm.pas
2018-03-24 20:21:46 +03:00

132 lines
3.6 KiB
ObjectPascal

unit RuntimeBuilder.Fasm;
interface
uses RuntimeBuilder.Types,FasmOnDelphi,System.TypInfo,System.Rtti,winapi.windows;
type
TRTBFasmCompiler=class(TRTBCompiler)
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;
TRTBLib=class abstract
private type
TRTBFasmLibFunc=class(TRTBFasmFunc)
public
//constructor Create(p:Pointer);
//destructor Destroy;override;
end;
private
//function GetFuntion(Name:string):TRTBFunc;virtual;abstract;
public
constructor Create(p:Pointer;sb:NativeUInt);
//property Funtion[Name:string]:TRTBFunc read GetFuntion;
//destructor Destroy;override;
end;
protected
FText:string;
function GetText:string;override;
procedure SetText(S:string);override;
public
constructor Create(Compiler:TRTBFasmCompiler);
function CompilateAsFunc:TRTBFunc;override;
function CompilateAsLib:TRTBLib;virtual;abstract;
end;
public
CompilerMem:NativeUInt;
MaxSteps:word;
constructor Create(FasmPath:String=FasmPath;AsDll:boolean=false);
//function LoadLib(Name:string):TRTBLib;
function GenNewSrc():TRTBSource;override;
end;
implementation
uses System.SysUtils;
constructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmFunc.Create(p:Pointer;sb:NativeUInt);
begin
Self.p:=VirtualAlloc(nil,sb,MEM_COMMIT ,PAGE_EXECUTE_READWRITE);
CopyMemory(Self.p,p,sb);
Self.sb:=sb;
FreeMem(p);
end;
function TRTBFasmCompiler.TRTBFasmSource.TRTBFasmFunc.Call(OutType:PTypeInfo;args:TArray<TValue>;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;
{$IFDEF CPUX64}
//function()
{$ENDIF}
begin
{$IFDEF CPUX64}
Result:=Invoke(p,args,ccReg,OutType);
{$ELSE}
case CallType of
CRTBCallTypeRegister,CRTBCallTypeDefault: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.TRTBFasmFunc.Destroy;
begin
VirtualFree(p,sb,MEM_RELEASE);
p:=nil;
end;
constructor TRTBFasmCompiler.TRTBFasmSource.TRTBLib.Create(p:Pointer;sb:NativeUInt);
begin
end;
function TRTBFasmCompiler.TRTBFasmSource.GetText:string;
begin
Result:=FText;
end;
procedure TRTBFasmCompiler.TRTBFasmSource.SetText(S:string);
begin
FText:=S;
end;
constructor TRTBFasmCompiler.TRTBFasmSource.Create(Compiler:TRTBFasmCompiler);
begin
inherited Create(Compiler);
FText:='';
end;
function TRTBFasmCompiler.TRTBFasmSource.CompilateAsFunc:TRTBFunc;
var
Res:TFasmResult;
begin
Res:=FasmAssemble(Text,(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);
end;
constructor TRTBFasmCompiler.Create(FasmPath:String=FasmPath;AsDll:boolean=false);
begin
CompilerMem:=1024*1024*16;
MaxSteps:=65535;
OpenFASM(FasmPath,AsDll);
end;
function TRTBFasmCompiler.GenNewSrc():TRTBSource;
begin
Result:=TRTBFasmSource.Create(Self);
end;
end.