This commit is contained in:
2018-03-27 00:56:30 +03:00
parent 97c84efe7f
commit da5f7dd342
8 changed files with 201 additions and 103 deletions

Submodule FasmOnDelphi updated: cd49f90470...62a5d170ba

View File

@@ -2,7 +2,9 @@ unit RuntimeBuilder.Fasm;
interface
uses RuntimeBuilder.Types,FasmOnDelphi,System.TypInfo,System.Rtti,winapi.windows;
uses
System.Classes,System.TypInfo,System.IOUtils,System.Rtti,Winapi.Windows,
RuntimeBuilder,FasmOnDelphi;
type
TRTBFasmCompiler=class(TRTBCompiler)
@@ -18,19 +20,20 @@ type
function Call(OutType:PTypeInfo;args:TArray<TValue>;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;override;
destructor Destroy;override;
end;
TRTBLib=class abstract
TRTBFasmLib=class(TRTBLib)
private type
TRTBFasmLibFunc=class(TRTBFasmFunc)
public
//constructor Create(p:Pointer);
//destructor Destroy;override;
constructor Create(p:Pointer);
destructor Destroy;override;
end;
private
//function GetFuntion(Name:string):TRTBFunc;virtual;abstract;
filename:string;
Lib:NativeUInt;
function GetFuntion(Name:string):TRTBFunc;override;
public
constructor Create(p:Pointer;sb:NativeUInt);
//property Funtion[Name:string]:TRTBFunc read GetFuntion;
//destructor Destroy;override;
constructor Create(Name:string);
destructor Destroy;override;
end;
protected
FText:string;
@@ -39,13 +42,16 @@ type
public
constructor Create(Compiler:TRTBFasmCompiler);
function CompilateAsFunc:TRTBFunc;override;
function CompilateAsLib:TRTBLib;virtual;abstract;
function CompilateAsLib:TRTBLib;override;
end;
protected
function GetIncLibs():string;
public
CompilerMem:NativeUInt;
MaxSteps:word;
libs:TStringList;
constructor Create(FasmPath:String=FasmPath;AsDll:boolean=false);
//function LoadLib(Name:string):TRTBLib;
function LoadLib(Name:string):TRTBLib;
function GenNewSrc():TRTBSource;override;
end;
@@ -85,9 +91,30 @@ VirtualFree(p,sb,MEM_RELEASE);
p:=nil;
end;
constructor TRTBFasmCompiler.TRTBFasmSource.TRTBLib.Create(p:Pointer;sb:NativeUInt);
constructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmLib.TRTBFasmLibFunc.Create(p:Pointer);
begin
Self.p:=p;
end;
destructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmLib.TRTBFasmLibFunc.Destroy;
begin
p:=nil;
end;
function TRTBFasmCompiler.TRTBFasmSource.TRTBFasmLib.GetFuntion(Name:string):TRTBFunc;
begin
Result:=TRTBFasmLibFunc.Create(GetProcAddress(Lib,pwidechar(Name)));
end;
constructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmLib.Create(Name:string);
begin
filename:=Name;
Lib:=LoadLibrary(pwidechar(Name));
end;
destructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmLib.Destroy;
begin
FreeLibrary(Lib);
end;
function TRTBFasmCompiler.TRTBFasmSource.GetText:string;
@@ -110,17 +137,46 @@ function TRTBFasmCompiler.TRTBFasmSource.CompilateAsFunc:TRTBFunc;
var
Res:TFasmResult;
begin
Res:=FasmAssemble(Text,(Compiler as TRTBFasmCompiler).CompilerMem,(Compiler as TRTBFasmCompiler).MaxSteps);
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);
end;
function TRTBFasmCompiler.TRTBFasmSource.CompilateAsLib:TRTBLib;
var
templib:string;
Res:TFasmResult;
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);
if Res.Error<>FASM_OK then
raise Exception.Create(Res.OutStr);
Result:=TRTBFasmLib.Create(templib);
end;
constructor TRTBFasmCompiler.Create(FasmPath:String=FasmPath;AsDll:boolean=false);
begin
CompilerMem:=1024*1024*16;
MaxSteps:=65535;
OpenFASM(FasmPath,AsDll);
libs:=TStringList.Create;
end;
function TRTBFasmCompiler.LoadLib(Name:string):TRTBLib;
begin
libs.Add(Name);
end;
function TRTBFasmCompiler.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.GenNewSrc():TRTBSource;

View File

@@ -1,84 +0,0 @@
unit RuntimeBuilder.Types;
interface
uses System.TypInfo,System.Rtti;
const
CRTBCallTypeNil=$0;
CRTBCallTypeRegister=$1;
CRTBCallTypeStdCall=$2;
CRTBCallTypeCdecl=$3;
CRTBCallTypePascal=$4;
CRTBCallTypeSafeCall=$5;
CRTBCallType64Call=$40;
CRTBCallTypeDefault=$80;
type
TRTBCompiler=class;
TRTBCallType=CRTBCallTypeNil..CRTBCallTypeDefault;
TRTBFunc=class abstract
public
function Call(OutType:PTypeInfo;args:TArray<TValue>;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;virtual;abstract;
end;
TRTBLib=class abstract
protected
function GetFuntion(Name:string):TRTBFunc;virtual;abstract;
public
property Funtion[Name:string]:TRTBFunc read GetFuntion;
end;
TRTBSource=class abstract
protected
Compiler:TRTBCompiler;
function GetText:string;virtual;abstract;
procedure SetText(S:string);virtual;abstract;
public
constructor Create(Compiler:TRTBCompiler);
function CompilateAsFunc:TRTBFunc;virtual;abstract;
function CompilateAsLib:TRTBLib;virtual;abstract;
procedure LoadFromFile(&File:string);
procedure SaveToFile(&File:string);
property Text:string read GetText write SetText;
end;
TRTBCompiler=class abstract
public
function LoadLib(Name:string):TRTBLib;virtual;abstract;
function GenNewSrc():TRTBSource;virtual;abstract;
end;
implementation
uses
System.SysUtils,System.Classes;
constructor TRTBSource.Create(Compiler:TRTBCompiler);
begin
Self.Compiler:=Compiler;
end;
procedure TRTBSource.LoadFromFile(&File:string);
var
Data:TStrings;
begin
Data:=TStringList.Create;
Data.LoadFromFile(&File);
Text:=Data.Text;
FreeAndNil(Data);
end;
procedure TRTBSource.SaveToFile(&File:string);
var
Data:TStrings;
begin
Data:=TStringList.Create;
Data.Text:=Text;
Data.SaveToFile(&File);
FreeAndNil(Data);
end;
end.

View File

@@ -2,8 +2,83 @@ unit RuntimeBuilder;
interface
uses RuntimeBuilder.Types;
uses System.TypInfo,System.Rtti;
const
CRTBCallTypeNil=$0;
CRTBCallTypeRegister=$1;
CRTBCallTypeStdCall=$2;
CRTBCallTypeCdecl=$3;
CRTBCallTypePascal=$4;
CRTBCallTypeSafeCall=$5;
CRTBCallType64Call=$40;
CRTBCallTypeDefault=$80;
type
TRTBCompiler=class;
TRTBCallType=CRTBCallTypeNil..CRTBCallTypeDefault;
TRTBFunc=class abstract
public
function Call(OutType:PTypeInfo;args:TArray<TValue>;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;virtual;abstract;
end;
TRTBLib=class abstract
protected
function GetFuntion(Name:string):TRTBFunc;virtual;abstract;
public
property Funtion[Name:string]:TRTBFunc read GetFuntion;
end;
TRTBSource=class abstract
protected
Compiler:TRTBCompiler;
function GetText:string;virtual;abstract;
procedure SetText(S:string);virtual;abstract;
public
constructor Create(Compiler:TRTBCompiler);
function CompilateAsFunc:TRTBFunc;virtual;abstract;
function CompilateAsLib:TRTBLib;virtual;abstract;
procedure LoadFromFile(&File:string);
procedure SaveToFile(&File:string);
property Text:string read GetText write SetText;
end;
TRTBCompiler=class abstract
public
function LoadLib(Name:string):TRTBLib;virtual;abstract;
function GenNewSrc():TRTBSource;virtual;abstract;
end;
implementation
uses
System.SysUtils,System.Classes;
constructor TRTBSource.Create(Compiler:TRTBCompiler);
begin
Self.Compiler:=Compiler;
end;
procedure TRTBSource.LoadFromFile(&File:string);
var
Data:TStrings;
begin
Data:=TStringList.Create;
Data.LoadFromFile(&File);
Text:=Data.Text;
FreeAndNil(Data);
end;
procedure TRTBSource.SaveToFile(&File:string);
var
Data:TStrings;
begin
Data:=TStringList.Create;
Data.Text:=Text;
Data.SaveToFile(&File);
FreeAndNil(Data);
end;
end.

View File

@@ -13,7 +13,6 @@ uses
DUnitX.TestFramework,
Unit1 in 'Unit1.pas',
RuntimeBuilder in '..\Source\RuntimeBuilder.pas',
RuntimeBuilder.Types in '..\Source\RuntimeBuilder.Types.pas',
RuntimeBuilder.Fasm in '..\Source\RuntimeBuilder.Fasm.pas',
FasmOnDelphi in '..\FasmOnDelphi\Source\FasmOnDelphi.pas',
Fasm4Delphi in '..\FasmOnDelphi\Fasm4Delphi\Source\Fasm4Delphi.pas';

View File

@@ -97,7 +97,6 @@
</DelphiCompile>
<DCCReference Include="Unit1.pas"/>
<DCCReference Include="..\Source\RuntimeBuilder.pas"/>
<DCCReference Include="..\Source\RuntimeBuilder.Types.pas"/>
<DCCReference Include="..\Source\RuntimeBuilder.Fasm.pas"/>
<DCCReference Include="..\FasmOnDelphi\Source\FasmOnDelphi.pas"/>
<DCCReference Include="..\FasmOnDelphi\Fasm4Delphi\Source\Fasm4Delphi.pas"/>
@@ -457,13 +456,13 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="OSX32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Android" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="OSX32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
</Deployment>
<Platforms>
<Platform value="OSX32">False</Platform>

View File

@@ -3,7 +3,7 @@ unit Unit1;
interface
uses
System.SysUtils,DUnitX.TestFramework,RuntimeBuilder,RuntimeBuilder.Fasm,RuntimeBuilder.Types;
System.SysUtils,DUnitX.TestFramework,RuntimeBuilder,RuntimeBuilder.Fasm;
type
[TestFixture]
@@ -11,6 +11,8 @@ type
public
[TestCase]
procedure Test1();
[TestCase]
procedure Test2();
end;
implementation
@@ -34,6 +36,28 @@ FreeAndNil(Src);
FreeAndNil(Fasm);
end;
procedure TRuntimeBuilderTestObject.Test2();
var
Fasm:TRTBFasmCompiler;
Src:TRTBSource;
lib:TRTBLib;
Func1:TRTBFunc;
begin
Fasm:=TRTBFasmCompiler.Create('..\..\..\FasmOnDelphi\fasmw172\fasm');
Src:=Fasm.GenNewSrc;
Src.LoadFromFile('..\..\testlib.fasm');
Fasm.LoadLib('W:\RuntimeBuilder\FasmOnDelphi\fasmw172\INCLUDE\win32a.inc');
lib:=Src.CompilateAsLib;
Func1:=lib.Funtion['MyEcho'];
if 234665<>Func1.Call(TypeInfo(integer),[234665],CRTBCallTypeStdCall).AsInteger then
begin
raise Exception.Create('Error in test2');
end;
FreeAndNil(Func1);
FreeAndNil(Src);
FreeAndNil(Fasm);
end;
initialization
TDUnitX.RegisterTestFixture(TRuntimeBuilderTestObject);
end.

29
Tests/testlib.fasm Normal file
View File

@@ -0,0 +1,29 @@
entry DllEntryPoint
section '.text' code readable executable
proc DllEntryPoint hinstDLL,fdwReason,lpvReserved
mov eax,TRUE
ret
endp
proc MyEcho HWnd
mov eax,[HWnd]
ret
endp
dd GetLastError
section '.idata' import data readable writeable
library kernel,'KERNEL32.DLL'
import kernel,\
GetLastError,'GetLastError'
section '.edata' export data readable
export '1.DLL',\
MyEcho,'MyEcho'
section '.reloc' fixups data readable discardable