RuntimeBuilder/Source/RuntimeBuilder.Fasm.pas

unit RuntimeBuilder.Fasm;

interface

//{$INLINE auto}

uses
  System.Classes,System.TypInfo,System.IOUtils,System.Rtti,Winapi.Windows,
    RuntimeBuilder,FasmOnDelphi;

type
  TRTBFasmCompiler=class(TRTBCompiler)
    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<TValue>;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;override;
              destructor Destroy;override;
          end;
          TRTBFasmLib=class(TRTBLib)
            private type
              TRTBFasmLibFunc=class(TRTBFasmFunc)
                public
                  constructor Create(p:Pointer);
                  destructor Destroy;override;
              end;
            private
              filename:string;
              Lib:NativeUInt;
              function GetFuntion(Name:string):TRTBFunc;override;
            public
              constructor Create(Name:string);
              destructor Destroy;override;
          end;
        protected
          libs:TStringList;
          function GetIncLibs():string;
        protected
          FText: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;
      end;
    public
      CompilerMem:NativeUInt;
      MaxSteps:word;
      constructor Create(FasmPath:String=FasmPath;AsDll:boolean=false);
      function GenNewSrc():TRTBSource;override;
  end;

implementation

uses System.SysUtils;

constructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmFunc.Create(p:Pointer;sb:NativeUInt);
begin
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;
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.TRTBFasmLib.TRTBFasmLibFunc.Create(p:Pointer);
begin
Self.p:=p;
end;

destructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmLib.TRTBFasmLibFunc.Destroy;
begin
p:=nil;
end;

function TRTBFasmCompiler.TRTBFasmSource.TRTBFasmLib.GetFuntion(Name:string):TRTBFunc;
begin
Result:=TRTBFasmLibFunc.Create(GetProcAddress(Lib,pwidechar(Name)));
end;

constructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmLib.Create(Name:string);
begin
filename:=Name;
Lib:=LoadLibrary(pwidechar(Name));
end;

destructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmLib.Destroy;
begin
FreeLibrary(Lib);
end;

function TRTBFasmCompiler.TRTBFasmSource.GetText:string;
begin
Result:=FText;
end;

procedure TRTBFasmCompiler.TRTBFasmSource.SetText(S:string);
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;
end;

function TRTBFasmCompiler.TRTBFasmSource.LoadLib(Name:string):TRTBLib;
begin
libs.Add(Name);
end;

function TRTBFasmCompiler.TRTBFasmSource.CompilateAsFunc:TRTBFunc;
var
  Res:TFasmResult;
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);
end;

function TRTBFasmCompiler.TRTBFasmSource.CompilateAsLib:TRTBLib;
var
  templib:string;
  Res:TFasmResult;
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);
if Res.Error<>FASM_OK then
  raise Exception.Create(Res.OutStr);
Result:=TRTBFasmLib.Create(templib);
end;

constructor TRTBFasmCompiler.Create(FasmPath:String=FasmPath;AsDll:boolean=false);
begin
CompilerMem:=1024*1024*16;
MaxSteps:=65535;
OpenFASM(FasmPath,AsDll);
end;

function TRTBFasmCompiler.GenNewSrc():TRTBSource;
begin
Result:=TRTBFasmSource.Create(Self);
end;

end.