Fasm 1/2 writed

2018-03-24 20:21:46 +03:00
parent 5f86c714b0
commit 0861047b15
5 changed files with 99 additions and 17 deletions
--- 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<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;
--- 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<TValue>;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;virtual;abstract;
  end;

  TRTBLib=class abstract
--- a/Tests/Project2.dproj
+++ b/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>
--- 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
--- a/Tests/Win64/Debug/dunitx-results.xml
+++ b/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>