API Update+Base FASM Support

.gitmodules

@@ -1,5 +1,5 @@
 [submodule "FasmOnDelphi"]
-	path = FasmOnDelphi
+	path = lib/FasmOnDelphi
 	url = git@git.teamfnd.ru:artem3213212/FasmOnDelphi.git
 [submodule "lib/pLua-XE"]
 	path = lib/pLua-XE

Source/RuntimeBuilder.Fasm.pas

@@ -5,7 +5,7 @@ interface
 //{$INLINE auto}
 
 uses
-  System.Classes,System.TypInfo,System.IOUtils,System.Rtti,Winapi.Windows,
+  System.Classes,System.TypInfo,System.IOUtils,System.Rtti,System.Generics.Collections,Winapi.Windows,
     RuntimeBuilder,FasmOnDelphi;
 
 type
@@ -13,42 +13,68 @@ type
     protected type
       TRTBFasmSource=class(TRTBSource)
     	protected type
-          TRTBFasmFunc=class(TRTBFunc)
+          TRTBFasmModule=class(TRTBModule)
-            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;
-          TRTBFasmLib=class(TRTBLib)
             private type
-              TRTBFasmLibFunc=class(TRTBFasmFunc)
+              TRTBFasmFunc=class(TRTBFunc)
+                private
+                  p:Pointer;
                 public
                   constructor Create(p:Pointer);
-                  destructor Destroy;override;
+                  function Call(OutType:PTypeInfo;args:TArray<TValue>;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;override;
               end;
+              {TRTBFasmVar=class(TRTBVar)
+                protected
+                  function SetVal(Val:TValue);virtual;abstract;
+                  function GetVal:TValue;virtual;abstract;
+                public
+                  property Val:TValue read GetVal write SetVal;
+              end;}
             private
-              filename:string;
+              p:Pointer;
-              Lib:NativeUInt;
+              sb:NativeUInt;
+              funcs:TDictionary<string,NativeUInt>;
               function GetFuntion(Name:string):TRTBFunc;override;
+              {function GetVar(Name:string):TRTBVar;override;}
             public
-              constructor Create(Name:string);
+              constructor Create(p:Pointer;sb:NativeUInt;funcs:TDictionary<string,NativeUInt>);
               destructor Destroy;override;
           end;
         protected
           libs:TStringList;
-          function GetIncLibs():string;
+          funcs:TStringList;
-        protected
+          regvars:TList<TPair<string,PTypeInfo>>;
           FText:string;
+          function GetIncLibs():string;
       	  function GetText:string;override;
           procedure SetText(S:string);override;
         public
-          function LoadLib(Name:string):TRTBLib;override;
           constructor Create(Compiler:TRTBFasmCompiler);
-          function CompilateAsFunc:TRTBFunc;override;
+
-          function CompilateAsLib:TRTBLib;override;
+          {procedure LoadLib(Name:string);override;
+          procedure UnLoadLib(Name:string);override;
+
+          procedure AddNameSpace(Name:string);override;
+          procedure DelNameSpace(Name:string);override;
+
+          procedure AddType(NameSpace:string;Name:string;&Type:TRTBType);override;
+          procedure ExportType(NameSpace:string;Name:string;&Type:TRTBType);override;
+          procedure DelType(NameSpace:string;Name:string);override;
+
+          procedure AddConst(NameSpace:string;Name:string;Val:TValue);override;
+          procedure ExportConst(NameSpace:string;Name:string;Val:TValue);override;
+          procedure DelConst(NameSpace:string;Name:string);override;
+
+          procedure AddVariable(NameSpace:string;Name:string;var Data);override;
+          procedure ExportVariable(NameSpace:string;Name:string;var Data);override;
+          procedure DelVariable(NameSpace:string;Name:string);override;}
+
+          procedure &Register(NameSpace:string;Name:string;&Type:TRTBType);override;
+          //procedure UnRegister(NameSpace:string;Name:string;&Type:TRTBType);override;
+          procedure RegisterFunction(NameSpace:string;Name:string);override;
+          //procedure UnRegisterFunction(NameSpace:string;Name:string);override;
+
+          function Compilate:TRTBModule;override;
+          destructor Destroy;override;
       end;
     public
       CompilerMem:NativeUInt;
@@ -61,21 +87,19 @@ implementation
 
 uses System.SysUtils;
 
-constructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmFunc.Create(p:Pointer;sb:NativeUInt);
+constructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmModule.TRTBFasmFunc.Create(p:Pointer);
 begin
-Self.p:=VirtualAlloc(nil,sb,MEM_COMMIT ,PAGE_EXECUTE_READWRITE);
+inherited Create();
-CopyMemory(Self.p,p,sb);
+Self.p:=p;
-Self.sb:=sb;
-FreeMem(p);
 end;
 
-function TRTBFasmCompiler.TRTBFasmSource.TRTBFasmFunc.Call(OutType:PTypeInfo;args:TArray<TValue>;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;
+function TRTBFasmCompiler.TRTBFasmSource.TRTBFasmModule.TRTBFasmFunc.Call(OutType:PTypeInfo;args:TArray<TValue>;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;
 begin
 {$IFDEF CPUX64}
 Result:=Invoke(p,args,ccReg,OutType);
 {$ELSE}
 case CallType of
-CRTBCallTypeRegister,CRTBCallTypeDefault:Result:=Invoke(p,args,ccReg,OutType);
+CRTBCallTypeRegister: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);
@@ -84,13 +108,7 @@ end;
 {$ENDIF}
 end;
 
-destructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmFunc.Destroy;
+(*constructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmLib.TRTBFasmLibFunc.Create(p:Pointer);
-begin
-VirtualFree(p,sb,MEM_RELEASE);
-p:=nil;
-end;
-
-constructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmLib.TRTBFasmLibFunc.Create(p:Pointer);
 begin
 Self.p:=p;
 end;
@@ -103,17 +121,35 @@ end;
 function TRTBFasmCompiler.TRTBFasmSource.TRTBFasmLib.GetFuntion(Name:string):TRTBFunc;
 begin
 Result:=TRTBFasmLibFunc.Create(GetProcAddress(Lib,pwidechar(Name)));
+end;*)
+
+{$POINTERMATH ON}
+function TRTBFasmCompiler.TRTBFasmSource.TRTBFasmModule.GetFuntion(Name:string):TRTBFunc;
+begin
+Result:=TRTBFasmFunc.Create(Pointer(PNativeUInt(NativeUInt(funcs.Items[Name])+NativeUInt(p))^+NativeUInt(p)));
 end;
 
-constructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmLib.Create(Name:string);
+constructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmModule.Create(p:Pointer;sb:NativeUInt;funcs:TDictionary<string,NativeUInt>);
 begin
-filename:=Name;
+Self.p:=VirtualAlloc(nil,sb,MEM_COMMIT,PAGE_EXECUTE_READWRITE);
-Lib:=LoadLibrary(pwidechar(Name));
+CopyMemory(Self.p,p,sb);
+Self.sb:=sb;
+Self.funcs:=funcs;
+FreeMem(p);
 end;
 
-destructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmLib.Destroy;
+destructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmModule.Destroy;
 begin
-FreeLibrary(Lib);
+VirtualFree(p,sb,MEM_RELEASE);
+end;
+
+function TRTBFasmCompiler.TRTBFasmSource.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.TRTBFasmSource.GetText:string;
@@ -126,53 +162,72 @@ begin
 FText:=S;
 end;
 
-function TRTBFasmCompiler.TRTBFasmSource.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;
-
 constructor TRTBFasmCompiler.TRTBFasmSource.Create(Compiler:TRTBFasmCompiler);
 begin
 inherited Create(Compiler);
 FText:='';
 libs:=TStringList.Create;
+funcs:=TStringList.Create;
 end;
 
-function TRTBFasmCompiler.TRTBFasmSource.LoadLib(Name:string):TRTBLib;
+{function TRTBFasmCompiler.TRTBFasmSource.LoadLib(Name:string):TRTBLib;
 begin
 libs.Add(Name);
+end;}
+
+procedure TRTBFasmCompiler.TRTBFasmSource.&Register(NameSpace:string;Name:string;&Type:TRTBType);
+begin
+if NameSpace<>'' then
+  &Register('',NameSpace+'.'+Name,&Type)
+else
+begin
+
+  //
+end;
 end;
 
-function TRTBFasmCompiler.TRTBFasmSource.CompilateAsFunc:TRTBFunc;
+procedure TRTBFasmCompiler.TRTBFasmSource.RegisterFunction(NameSpace:string;Name:string);
-var
-  Res:TFasmResult;
 begin
-Res:=FasmAssemble(Text+(Compiler as TRTBFasmCompiler).GetIncLibs,(Compiler as TRTBFasmCompiler).CompilerMem,(Compiler as TRTBFasmCompiler).MaxSteps);
+if NameSpace<>'' then
-if Res.Error<>FASM_OK then
+  funcs.Add(NameSpace+'.'+Name)
-  raise Exception.Create(Res.OutStr);
+else
-Result:=TRTBFasmFunc.Create(Res.OutData,Res.sb);
+  funcs.Add(Name);
 end;
 
-function TRTBFasmCompiler.TRTBFasmSource.CompilateAsLib:TRTBLib;
+function TRTBFasmCompiler.TRTBFasmSource.Compilate:TRTBModule;
 var
-  templib:string;
+  templib,pointerDecl,FuncDecl:string;
   Res:TFasmResult;
+  i:NativeUInt;
+  FuncDict:TDictionary<string,NativeUInt>;
 begin
-templib:=TPath.GetTempFileName;
+case SizeOf(pointer) of
-Res:=FasmAssembleToFile({$IFDEF CPUX64}'format PE64 DLL'{$ELSE}'format PE DLL'{$ENDIF}+
+2:pointerDecl:='dw ';
-  (Compiler as TRTBFasmCompiler).GetIncLibs+sLineBreak+Text,templib,
+4:pointerDecl:='dd ';
-  (Compiler as TRTBFasmCompiler).CompilerMem,(Compiler as TRTBFasmCompiler).MaxSteps);
+8:pointerDecl:='dq ';
+end;
+FuncDecl:='';
+FuncDict:=TDictionary<string,NativeUInt>.Create();
+for i:=0 to funcs.Count-1 do
+begin
+  FuncDecl:=FuncDecl+pointerDecl+funcs.Strings[i]+sLineBreak;
+  FuncDict.Add(funcs.Strings[i],i*SizeOf(pointer));
+end;
+Res:=FasmAssemble(FuncDecl+Text+GetIncLibs,(Compiler as TRTBFasmCompiler).CompilerMem,(Compiler as TRTBFasmCompiler).MaxSteps);
 if Res.Error<>FASM_OK then
   raise Exception.Create(Res.OutStr);
-Result:=TRTBFasmLib.Create(templib);
+Result:=TRTBFasmModule.Create(Res.OutData,Res.sb,FuncDict);
+end;
+
+destructor TRTBFasmCompiler.TRTBFasmSource.Destroy;
+begin
+FreeAndNil(libs);
+FreeAndNil(funcs);
 end;
 
 constructor TRTBFasmCompiler.Create(FasmPath:String=FasmPath;AsDll:boolean=false);
 begin
+inherited Create();
 CompilerMem:=1024*1024*16;
 MaxSteps:=65535;
 OpenFASM(FasmPath,AsDll);

Source/RuntimeBuilder.pas

@@ -6,7 +6,7 @@ uses
   System.TypInfo,System.Rtti;
 
 const
-  CRTBCallTypeNil=ccReg;
+  CRTBCallTypeNil=ccStdCall;
   CRTBCallTypeRegister=ccReg;
   CRTBCallTypeStdCall=ccStdCall;
   CRTBCallTypeCdecl=ccCdecl;
@@ -25,23 +25,24 @@ type
 
   TRTBFunc=class abstract
     public
-      function Call(Name:string;OutType:PTypeInfo;args:TArray<TValue>;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;virtual;abstract;
+      function Call(OutType:PTypeInfo;args:TArray<TValue>;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;virtual;abstract;
   end;
 
   TRTBVar=class abstract
     protected
-      function SetVal(TValue);virtual;abstract;
+      procedure SetVal(Val:TValue);virtual;abstract;
       function GetVal:TValue;virtual;abstract;
     public
       property Val:TValue read GetVal write SetVal;
   end;
 
-  TRTBLib=class abstract
+  TRTBModule=class abstract
     protected
       function GetFuntion(Name:string):TRTBFunc;virtual;abstract;
+      function GetVar(Name:string):TRTBVar;virtual;abstract;
     public
       property Funtion[Name:string]:TRTBFunc read GetFuntion;
-      property &Var[Name:string]:TRTBVar read GetFuntion;
+      property &Var[Name:string]:TRTBVar read GetVar;
   end;
 
   TRTBSource=class abstract
@@ -71,11 +72,13 @@ type
       procedure DelVariable(NameSpace:string;Name:string);virtual;abstract;
 
       procedure &Register(NameSpace:string;Name:string;&Type:TRTBType);virtual;abstract;
+      procedure UnRegister(NameSpace:string;Name:string;&Type:TRTBType);virtual;abstract;
       procedure &RegisterFunction(NameSpace:string;Name:string);virtual;abstract;
+      procedure UnRegisterFunction(NameSpace:string;Name:string);virtual;abstract;
 
-      function Compilate:TRTBLib;virtual;abstract;
+      function Compilate:TRTBModule;virtual;abstract;
-      procedure LoadFromFile(&File:string);
+      procedure LoadFromFile(&File:string);virtual;
-      procedure SaveToFile(&File:string);
+      procedure SaveToFile(&File:string);virtual;
       property Text:string read GetText write SetText;
   end;
 

Tests/Project2.dproj

@@ -467,13 +467,13 @@
                         <Operation>1</Operation>
                     </Platform>
                 </DeployClass>
-                <ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
+                <ProjectRoot Platform="iOSSimulator" 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="OSX32" Name="$(PROJECTNAME)"/>
-                <ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>
+                <ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
             </Deployment>
             <Platforms>
                 <Platform value="OSX32">False</Platform>

Tests/Unit1.pas

@@ -23,24 +23,24 @@ var
   Src:TRTBSource;
   Func1:TRTBFunc;
 begin
-{Fasm:=TRTBFasmCompiler.Create('..\..\..\FasmOnDelphi\fasmw172\fasm');
+Fasm:=TRTBFasmCompiler.Create('..\..\..\lib\FasmOnDelphi\fasmw172\fasm');
 Src:=Fasm.GenNewSrc;
-Src.Text:='use32'+sLineBreak+'pop ecx'+sLineBreak+'pop eax'+sLineBreak+'jmp ecx';
+Src.Text:='use32'+sLineBreak+'main:'+sLineBreak+'pop ecx'+sLineBreak+'pop eax'+sLineBreak+'jmp ecx';
-Func1:=src.CompilateAsFunc;
+Src.RegisterFunction('','main');
+Func1:=src.Compilate.Funtion['main'];
 if 454<>Func1.Call(TypeInfo(integer),[454],CRTBCallTypeStdCall).AsInteger then
 begin
   raise Exception.Create('Error in test1');
 end;
 FreeAndNil(Func1);
 FreeAndNil(Src);
-FreeAndNil(Fasm);}
+FreeAndNil(Fasm);
 end;
 
 procedure TRuntimeBuilderTestObject.Test2();
 var
   Fasm:TRTBFasmCompiler;
   Src:TRTBSource;
-  lib:TRTBLib;
   Func1:TRTBFunc;
 begin
 {Fasm:=TRTBFasmCompiler.Create('..\..\..\FasmOnDelphi\fasmw172\fasm');