Fasm 1/2 writed

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

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;
+  CRTBCallTypePascal=$4;
-  CRTBCallTypeThiscall=$5;
+  CRTBCallTypeSafeCall=$5;
-  CRTBCallTypeVectorcall=$6;
-  CRTBCallTypeCFastCall=$7;
-  CRTBCallTypeFortran=$8;
-  CRTBCallTypeSyscall=$9;
   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<TValue>;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;virtual;abstract;
   end;
 
   TRTBLib=class abstract

Tests/Project2.dproj

@@ -6,7 +6,7 @@
         <Base>True</Base>
         <Config Condition="'$(Config)'==''">Debug</Config>
         <Platform Condition="'$(Platform)'==''">Win32</Platform>
-        <TargetedPlatforms>1</TargetedPlatforms>
+        <TargetedPlatforms>3</TargetedPlatforms>
         <AppType>Console</AppType>
         <FrameworkType>None</FrameworkType>
     </PropertyGroup>
@@ -69,6 +69,9 @@
         <VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
     </PropertyGroup>
     <PropertyGroup Condition="'$(Base_Win64)'!=''">
+        <VerInfo_Locale>1033</VerInfo_Locale>
+        <DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)</DCC_Namespace>
+        <VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
         <DCC_UsePackage>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)</DCC_UsePackage>
     </PropertyGroup>
     <PropertyGroup Condition="'$(Cfg_1)'!=''">
@@ -454,18 +457,18 @@
                         <Operation>1</Operation>
                     </Platform>
                 </DeployClass>
-                <ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>
+                <ProjectRoot Platform="iOSDevice32" 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="iOSSimulator" Name="$(PROJECTNAME).app"/>
                 <ProjectRoot Platform="OSX32" Name="$(PROJECTNAME)"/>
-                <ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
             </Deployment>
             <Platforms>
                 <Platform value="OSX32">False</Platform>
                 <Platform value="Win32">True</Platform>
-                <Platform value="Win64">False</Platform>
+                <Platform value="Win64">True</Platform>
             </Platforms>
         </BorlandProject>
         <ProjectFileVersion>12</ProjectFileVersion>

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

Tests/Win64/Debug/dunitx-results.xml

@@ -0,0 +1,26 @@
+<?xml version="1.0" encoding="UTF-8" standalone="yes" ?>
+<test-results name="W:\RuntimeBuilder\Tests\Win64\Debug\Project2.exe" total="1" errors="1" failures="0" ignored="0" inconclusive="0" not-run="0" skipped="0" invalid="0" date="2018-03-24" time="0.045">
+  <culture-info current-culture="en" current-uiculture="en" />
+  <test-suite type="Assembly" name="Project2.exe" executed="true" result="Failure" success="False" time="0.045" asserts="0">
+    <results>
+        <test-suite type="Namespace" name="Unit1" executed="true" result="Success" success="True" time="0.045" asserts="0" >
+          <results>
+              <test-suite type="Fixture" name="TRuntimeBuilderTestObject" executed="True" result="Success" success="True" time="0.045" >
+                <results>
+                  <test-case name="Test1." executed="True" result="Error" success="False" time="0.045" asserts="0" >
+                    <failure>
+                      <message>
+                        <![CDATA[ 2 ]]>
+                      </message>
+                      <stack-trace>
+                        <![CDATA[  ]]>
+                      </stack-trace>
+                    </failure>
+                  </test-case>
+                </results>
+              </test-suite>
+          </results>
+        </test-suite>
+    </results>
+  </test-suite>
+</test-results>