From 0e25c2e70f816a499219533af609de3df3eeb28e Mon Sep 17 00:00:00 2001 From: Artem3213212 Date: Thu, 12 Apr 2018 16:35:32 +0300 Subject: [PATCH] API Update+Base FASM Support --- .gitmodules | 2 +- Source/RuntimeBuilder.Fasm.pas | 183 +++++++++++++++++++++------------ Source/RuntimeBuilder.pas | 19 ++-- Tests/Project2.dproj | 4 +- Tests/Unit1.pas | 10 +- 5 files changed, 138 insertions(+), 80 deletions(-) diff --git a/.gitmodules b/.gitmodules index 02c7b92..9998281 100644 --- a/.gitmodules +++ b/.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 diff --git a/Source/RuntimeBuilder.Fasm.pas b/Source/RuntimeBuilder.Fasm.pas index 2608a67..3dac9f0 100644 --- a/Source/RuntimeBuilder.Fasm.pas +++ b/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) - protected - p:Pointer; - sb:NativeUInt; - public - constructor Create(p:Pointer;sb:NativeUInt); - function Call(OutType:PTypeInfo;args:TArray;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;override; - destructor Destroy;override; - end; - TRTBFasmLib=class(TRTBLib) + TRTBFasmModule=class(TRTBModule) 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;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; - Lib:NativeUInt; + p:Pointer; + sb:NativeUInt; + funcs:TDictionary; 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); destructor Destroy;override; end; protected libs:TStringList; - function GetIncLibs():string; - protected + funcs:TStringList; + regvars:TList>; 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); -CopyMemory(Self.p,p,sb); -Self.sb:=sb; -FreeMem(p); +inherited Create(); +Self.p:=p; end; -function TRTBFasmCompiler.TRTBFasmSource.TRTBFasmFunc.Call(OutType:PTypeInfo;args:TArray;CallType:TRTBCallType=CRTBCallTypeDefault):TValue; +function TRTBFasmCompiler.TRTBFasmSource.TRTBFasmModule.TRTBFasmFunc.Call(OutType:PTypeInfo;args:TArray;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; -begin -VirtualFree(p,sb,MEM_RELEASE); -p:=nil; -end; - -constructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmLib.TRTBFasmLibFunc.Create(p:Pointer); +(*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); begin -filename:=Name; -Lib:=LoadLibrary(pwidechar(Name)); +Self.p:=VirtualAlloc(nil,sb,MEM_COMMIT,PAGE_EXECUTE_READWRITE); +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; -var - Res:TFasmResult; +procedure TRTBFasmCompiler.TRTBFasmSource.RegisterFunction(NameSpace:string;Name:string); begin -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); +if NameSpace<>'' then + funcs.Add(NameSpace+'.'+Name) +else + 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; 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); +case SizeOf(pointer) of +2:pointerDecl:='dw '; +4:pointerDecl:='dd '; +8:pointerDecl:='dq '; +end; +FuncDecl:=''; +FuncDict:=TDictionary.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); diff --git a/Source/RuntimeBuilder.pas b/Source/RuntimeBuilder.pas index df3ddfc..9dedae3 100644 --- a/Source/RuntimeBuilder.pas +++ b/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;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;virtual;abstract; + function Call(OutType:PTypeInfo;args:TArray;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; - procedure LoadFromFile(&File:string); - procedure SaveToFile(&File:string); + function Compilate:TRTBModule;virtual;abstract; + procedure LoadFromFile(&File:string);virtual; + procedure SaveToFile(&File:string);virtual; property Text:string read GetText write SetText; end; diff --git a/Tests/Project2.dproj b/Tests/Project2.dproj index bcec15f..a4d16ba 100644 --- a/Tests/Project2.dproj +++ b/Tests/Project2.dproj @@ -467,13 +467,13 @@ 1 - + - + False diff --git a/Tests/Unit1.pas b/Tests/Unit1.pas index f37dee0..f9b6759 100644 --- a/Tests/Unit1.pas +++ b/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'; -Func1:=src.CompilateAsFunc; +Src.Text:='use32'+sLineBreak+'main:'+sLineBreak+'pop ecx'+sLineBreak+'pop eax'+sLineBreak+'jmp ecx'; +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');