diff --git a/Source/RuntimeBuilder.Fasm.pas b/Source/RuntimeBuilder.Fasm.pas index 96d4915..c794304 100644 --- a/Source/RuntimeBuilder.Fasm.pas +++ b/Source/RuntimeBuilder.Fasm.pas @@ -2,7 +2,7 @@ unit RuntimeBuilder.Fasm; interface -uses RuntimeBuilder.Types,FasmOnDelphi; +uses RuntimeBuilder.Types,FasmOnDelphi,System.TypInfo,System.Rtti,winapi.windows; type TRTBFasmCompiler=class(TRTBCompiler) @@ -15,13 +15,22 @@ type sb:NativeUInt; public constructor Create(p:Pointer;sb:NativeUInt); - //function Call(args:array of const;CallType:TRTBCallType=CRTBCallTypeDefault):Variant;override; + function Call(OutType:PTypeInfo;args:TArray;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; @@ -30,7 +39,7 @@ type public constructor Create(Compiler:TRTBFasmCompiler); function CompilateAsFunc:TRTBFunc;override; - //function CompilateAsLib:TRTBLib;virtual;abstract; + function CompilateAsLib:TRTBLib;virtual;abstract; end; public CompilerMem:NativeUInt; @@ -46,8 +55,39 @@ uses System.SysUtils; constructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmFunc.Create(p:Pointer;sb:NativeUInt); begin -Self.p:=p; +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;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; diff --git a/Source/RuntimeBuilder.Types.pas b/Source/RuntimeBuilder.Types.pas index 5a52b21..c1ba087 100644 --- a/Source/RuntimeBuilder.Types.pas +++ b/Source/RuntimeBuilder.Types.pas @@ -2,17 +2,15 @@ unit RuntimeBuilder.Types; interface +uses System.TypInfo,System.Rtti; + const CRTBCallTypeNil=$0; CRTBCallTypeRegister=$1; CRTBCallTypeStdCall=$2; CRTBCallTypeCdecl=$3; - CRTBCallTypeClrcall=$4; - CRTBCallTypeThiscall=$5; - CRTBCallTypeVectorcall=$6; - CRTBCallTypeCFastCall=$7; - CRTBCallTypeFortran=$8; - CRTBCallTypeSyscall=$9; + CRTBCallTypePascal=$4; + CRTBCallTypeSafeCall=$5; CRTBCallType64Call=$40; CRTBCallTypeDefault=$80; @@ -23,7 +21,7 @@ type TRTBFunc=class abstract public - function Call(args:array of const;CallType:TRTBCallType=CRTBCallTypeDefault):Variant;virtual;abstract; + function Call(OutType:PTypeInfo;args:TArray;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;virtual;abstract; end; TRTBLib=class abstract diff --git a/Tests/Project2.dproj b/Tests/Project2.dproj index fb66d4f..b004a11 100644 --- a/Tests/Project2.dproj +++ b/Tests/Project2.dproj @@ -6,7 +6,7 @@ True Debug Win32 - 1 + 3 Console None @@ -69,6 +69,9 @@ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + 1033 + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= FireDACTDataDriver;FireDACSqliteDriver;FireDACDSDriver;DBXSqliteDriver;FireDACPgDriver;fmx;IndySystem;TeeDB;tethering;vclib;DBXInterBaseDriver;DataSnapClient;DataSnapCommon;DataSnapServer;DataSnapProviderClient;DBXSybaseASEDriver;DbxCommonDriver;vclimg;dbxcds;DatasnapConnectorsFreePascal;appanalytics;vcldb;vcldsnap;fmxFireDAC;DBXDb2Driver;DBXOracleDriver;CustomIPTransport;vclribbon;dsnap;IndyIPServer;fmxase;vcl;IndyCore;DBXMSSQLDriver;CloudService;IndyIPCommon;FmxTeeUI;FireDACIBDriver;DataSnapFireDAC;FireDACDBXDriver;soapserver;inetdbxpress;dsnapxml;FireDACInfxDriver;FireDACDb2Driver;adortl;FireDACASADriver;bindcompfmx;FireDACODBCDriver;RESTBackendComponents;emsclientfiredac;rtl;dbrtl;DbxClientDriver;FireDACCommon;bindcomp;inetdb;Tee;DBXOdbcDriver;ibmonitor;vclFireDAC;xmlrtl;DataSnapNativeClient;ibxpress;IndyProtocols;DBXMySQLDriver;FireDACCommonDriver;bindcompdbx;bindengine;vclactnband;FMXTee;soaprtl;TeeUI;bindcompvcl;vclie;FireDACADSDriver;vcltouch;emsclient;VCLRESTComponents;FireDAC;DBXInformixDriver;FireDACMSSQLDriver;Intraweb;VclSmp;DataSnapConnectors;DataSnapServerMidas;DBXFirebirdDriver;dsnapcon;inet;fmxobj;FireDACMySQLDriver;soapmidas;vclx;DBXSybaseASADriver;FireDACOracleDriver;fmxdae;RESTComponents;dbexpress;FireDACMSAccDriver;DataSnapIndy10ServerTransport;IndyIPClient;$(DCC_UsePackage) @@ -454,18 +457,18 @@ 1 - + + - False True - False + True 12 diff --git a/Tests/Unit1.pas b/Tests/Unit1.pas index b78a057..e724c44 100644 --- a/Tests/Unit1.pas +++ b/Tests/Unit1.pas @@ -1,8 +1,9 @@ unit Unit1; interface + uses - DUnitX.TestFramework,RuntimeBuilder; + System.SysUtils,DUnitX.TestFramework,RuntimeBuilder,RuntimeBuilder.Fasm,RuntimeBuilder.Types; type [TestFixture] @@ -15,8 +16,22 @@ type implementation procedure TRuntimeBuilderTestObject.Test1(); +var + Fasm:TRTBFasmCompiler; + Src:TRTBSource; + Func1:TRTBFunc; begin - +Fasm:=TRTBFasmCompiler.Create('..\..\..\FasmOnDelphi\fasmw172\fasm'); +Src:=Fasm.GenNewSrc; +Src.Text:='use32'+sLineBreak+'pop ecx'+sLineBreak+'pop eax'+sLineBreak+'jmp ecx'; +Func1:=src.CompilateAsFunc; +if 454<>Func1.Call(TypeInfo(integer),[454],CRTBCallTypeStdCall).AsInteger then +begin + raise Exception.Create('Error in test1'); +end; +FreeAndNil(Func1); +FreeAndNil(Src); +FreeAndNil(Fasm); end; initialization diff --git a/Tests/Win64/Debug/dunitx-results.xml b/Tests/Win64/Debug/dunitx-results.xml new file mode 100644 index 0000000..e5d16f2 --- /dev/null +++ b/Tests/Win64/Debug/dunitx-results.xml @@ -0,0 +1,26 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +