unit RuntimeBuilder.Fasm;

interface

//{$INLINE auto}

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

type
  TRTBFasmCompiler=class(TRTBCompiler)
    protected type
      TRTBFasmSource=class(TRTBSource)
    	protected type
          TRTBFasmModule=class(TRTBModule)
            protected type
              TRTBFasmFunc=class(TRTBFunc)
                protected
                  p:Pointer;
                public
                  constructor Create(p:Pointer);
                  function Call(OutType:PTypeInfo;args:TArray<TValue>;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;override;
                  destructor Destroy;override;
              end;
              TRTBFasmVar=class(TRTBVar)
                protected
                  p:pointer;
                  &Type:TRTBType;
                  procedure SetVal(Val:TValue);override;
                  function GetVal:TValue;override;
                public
                  constructor Create(p:pointer;&Type:TRTBType);
                  destructor Destroy;override;
              end;
            protected
              p:Pointer;
              sb:NativeUInt;
              funcs:TDictionary<string,NativeUInt>;
              regvars:TDictionary<string,TPair<NativeUInt,PTypeInfo>>;
              function GetFuntion(Name:string):TRTBFunc;override;
              function GetVar(Name:string):TRTBVar;override;
            public
              constructor Create(p:Pointer;sb:NativeUInt;funcs:TDictionary<string,NativeUInt>;regvars:TDictionary<string,TPair<NativeUInt,PTypeInfo>>);
              destructor Destroy;override;
          end;
        protected
          libs:TStringList;
          funcs:TStringList;
          regvars:TList<TPair<string,PTypeInfo>>;
          consts:TList<TPair<string,TValue>>;
          callbacks:TList<TPair<string,TRTBCallBack>>;
          FText:string;
          function GetIncLibs():string;
      	  function GetText:string;override;
          procedure SetText(const S:string);override;
        public
          constructor Create(Compiler:TRTBFasmCompiler);

          procedure LoadLib(const Name:string);override;
          procedure UnLoadLib(const Name:string);override;

          procedure AddNameSpace(const Name:string);override;
          procedure DelNameSpace(const Name:string);override;

          procedure AddType(const NameSpace,Name:string;&Type:TRTBType);override;//-
          procedure DelType(const NameSpace,Name:string);override;//-

          procedure AddConst(const NameSpace,Name:string;Val:TValue);override;
          procedure DelConst(const NameSpace,Name:string);override;

          procedure AddVariable(const NameSpace,Name:string;var Data);override;
          procedure ExportVariable(const NameSpace,Name:string;var Data);override;
          procedure DelVariable(const NameSpace,Name:string);override;

          procedure AddCallBack(const NameSpace,Name:string;CallBack:TRTBCallBack);override;
          procedure DelCallBack(const NameSpace,Name:string);override;

          procedure &Register(const NameSpace,Name:string;&Type:TRTBType);override;
          procedure UnRegister(const NameSpace,Name:string);override;
          procedure RegisterFunction(const NameSpace,Name:string);override;
          procedure UnRegisterFunction(const NameSpace,Name:string);override;

          function Compilate:TRTBModule;override;
          destructor Destroy;override;
      end;
    public
      CompilerMem:NativeUInt;
      MaxSteps:word;
      constructor Create(FasmPath:String=FasmPath;AsDll:boolean=false);
      function GenNewSrc():TRTBSource;override;
  end;

implementation

uses System.SysUtils;

function CallBackCall(callbacks:TList<TPair<string,TRTBCallBack>>;n:NativeUInt;p:pointer):pointer;stdcall;
begin
with callbacks[n].Value([p])do
begin
  Result:=GetMemory(DataSize);
  ExtractRawData(Result);
end;
end;

constructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmModule.TRTBFasmFunc.Create(p:Pointer);
begin
inherited Create();
Self.p:=p;
end;

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: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.TRTBFasmModule.TRTBFasmFunc.Destroy;
begin
p:=nil;
end;

procedure TRTBFasmCompiler.TRTBFasmSource.TRTBFasmModule.TRTBFasmVar.SetVal(Val:TValue);
begin
if Val.TypeInfo=&Type then
  Val.ExtractRawData(p);
end;

function TRTBFasmCompiler.TRTBFasmSource.TRTBFasmModule.TRTBFasmVar.GetVal:TValue;
begin
TValue.Make(p,&Type,Result);
end;

constructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmModule.TRTBFasmVar.Create(p:pointer;&Type:TRTBType);
begin
Self.p:=p;
Self.&Type:=&Type;
end;

destructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmModule.TRTBFasmVar.Destroy;
begin
p:=nil;
&Type:=nil;
end;

function TRTBFasmCompiler.TRTBFasmSource.TRTBFasmModule.GetFuntion(Name:string):TRTBFunc;
begin
Result:=TRTBFasmFunc.Create(PPointer(NativeUInt(funcs.Items[Name])+NativeUInt(p))^);
end;

function TRTBFasmCompiler.TRTBFasmSource.TRTBFasmModule.GetVar(Name:string):TRTBVar;
begin
Result:=TRTBFasmVar.Create(PPointer(NativeUInt(regvars.Items[Name].Key)+NativeUInt(p))^,regvars.Items[Name].Value)
end;

constructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmModule.Create(p:Pointer;sb:NativeUInt;funcs:TDictionary<string,NativeUInt>;regvars:TDictionary<string,TPair<NativeUInt,PTypeInfo>>);
begin
Self.p:=p;
Self.sb:=sb;
Self.funcs:=funcs;
Self.regvars:=regvars;
end;

destructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmModule.Destroy;
begin
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;
begin
Result:=FText;
end;

procedure TRTBFasmCompiler.TRTBFasmSource.SetText(const S:string);
begin
FText:=S;
end;

constructor TRTBFasmCompiler.TRTBFasmSource.Create(Compiler:TRTBFasmCompiler);
begin
inherited Create(Compiler);
FText:='';
libs:=TStringList.Create;
funcs:=TStringList.Create;
regvars:=TList<TPair<string,PTypeInfo>>.Create;
consts:=TList<TPair<string,TValue>>.Create;
callbacks:=TList<TPair<string,TRTBCallBack>>.Create;
end;

procedure TRTBFasmCompiler.TRTBFasmSource.LoadLib(const Name:string);
begin
libs.Add(Name);
end;

procedure TRTBFasmCompiler.TRTBFasmSource.UnLoadLib(const Name:string);
begin
with libs do
  Delete(IndexOf(Name));
end;

procedure TRTBFasmCompiler.TRTBFasmSource.AddNameSpace(const Name:string);
begin
end;

procedure TRTBFasmCompiler.TRTBFasmSource.DelNameSpace(const Name:string);
label
  funcscontinue,regvarscontinue,constscontinue;
var
  i,i0:NativeUInt;
  tName:string;
begin
tName:=Name+'.';
i:=0;
while i<funcs.Count do
begin
  for i0:=1 to length(tName) do
    if funcs.Strings[i][i0]=tName[i0]then
      goto funcscontinue;
  funcs.Delete(i);
  inc(i);
  funcscontinue:
end;
i:=0;
while i<regvars.Count do
begin
  for i0:=1 to length(tName) do
    if regvars.Items[i].Key[i0]=tName[i0]then
      goto regvarscontinue;
  regvars.Delete(i);
  inc(i);
  regvarscontinue:
end;
i:=0;
while i<consts.Count do
begin
  for i0:=1 to length(tName) do
    if consts.Items[i].Key[i0]=tName[i0]then
      goto constscontinue;
  consts.Delete(i);
  inc(i);
  constscontinue:
end;
end;

procedure TRTBFasmCompiler.TRTBFasmSource.AddType(const NameSpace,Name:string;&Type:TRTBType);
begin
end;

procedure TRTBFasmCompiler.TRTBFasmSource.DelType(const NameSpace,Name:string);
begin
end;

procedure TRTBFasmCompiler.TRTBFasmSource.AddConst(const NameSpace,Name:string;Val:TValue);
begin
if NameSpace<>'' then
  consts.Add(TPair<string,TValue>.Create(NameSpace+'.'+Name,Val))
else
  consts.Add(TPair<string,TValue>.Create(Name,Val));
end;

procedure TRTBFasmCompiler.TRTBFasmSource.DelConst(const NameSpace,Name:string);
var
  i:NativeUInt;
begin
if consts.Count<>0 then
  for i:=0 to consts.Count-1 do
    if(consts.Items[i].Key=NameSpace+'.'+Name)or(consts.Items[i].Key=Name)then
    begin
      consts.Delete(i);
      Break;
    end;
end;

procedure TRTBFasmCompiler.TRTBFasmSource.AddVariable(const NameSpace,Name:string;var Data);
begin
if NameSpace<>'' then
  consts.Add(TPair<string,TValue>.Create(NameSpace+'.'+Name,addr(Data)))
else
  consts.Add(TPair<string,TValue>.Create(Name,addr(Data)));
end;

procedure TRTBFasmCompiler.TRTBFasmSource.ExportVariable(const NameSpace,Name:string;var Data);
begin
if NameSpace<>'' then
  consts.Add(TPair<string,TValue>.Create(NameSpace+'.'+Name,Addr(Data)))
else
  consts.Add(TPair<string,TValue>.Create(Name,Addr(Data)));
end;

procedure TRTBFasmCompiler.TRTBFasmSource.DelVariable(const NameSpace,Name:string);
begin
DelConst(NameSpace,Name);
end;

procedure TRTBFasmCompiler.TRTBFasmSource.AddCallBack(const NameSpace,Name:string;CallBack:TRTBCallBack);
begin
if NameSpace<>'' then
  callbacks.Add(TPair<string,TRTBCallBack>.Create(NameSpace+'.'+Name,CallBack))
else
  callbacks.Add(TPair<string,TRTBCallBack>.Create(Name,CallBack));
end;

procedure TRTBFasmCompiler.TRTBFasmSource.DelCallBack(const NameSpace,Name:string);
var
  i:NativeUInt;
begin
if callbacks.Count<>0 then
  for i:=0 to callbacks.Count-1 do
    if(callbacks.Items[i].Key=NameSpace+'.'+Name)or(callbacks.Items[i].Key=Name)then
    begin
      callbacks.Delete(i);
      Break;
    end;
end;

procedure TRTBFasmCompiler.TRTBFasmSource.&Register(const NameSpace,Name:string;&Type:TRTBType);
begin
if NameSpace<>'' then
  regvars.Add(TPair<string,PTypeInfo>.Create(NameSpace+'.'+Name,&Type))
else
  regvars.Add(TPair<string,PTypeInfo>.Create(Name,&Type));
end;

procedure TRTBFasmCompiler.TRTBFasmSource.UnRegister(const NameSpace,Name:string);
var
  i:NativeUInt;
begin
if regvars.Count<>0 then
  for i:=0 to regvars.Count-1 do
    if(regvars.Items[i].Key=Name)or(regvars.Items[i].Key=NameSpace+'.'+Name) then
    begin
      regvars.Delete(i);
      Break;
    end;
end;

procedure TRTBFasmCompiler.TRTBFasmSource.RegisterFunction(const NameSpace,Name:string);
begin
if NameSpace<>'' then
  funcs.Add(NameSpace+'.'+Name)
else
  funcs.Add(Name);
end;

procedure TRTBFasmCompiler.TRTBFasmSource.UnRegisterFunction(const NameSpace,Name:string);
begin
with funcs do
begin
  Delete(IndexOf(NameSpace+'.'+Name));
  Delete(IndexOf(Name));
end;
end;

function TRTBFasmCompiler.TRTBFasmSource.Compilate:TRTBModule;
  procedure VarParse(key:string;Value:TValue;var PreDecl:string;var base:NativeUInt);
  var
    i:NativeUInt;
    p0:PByte;
    rfield:TRttiField;
    rmetod:TRttiMethod;
  begin
        if Value.IsType<AnsiString> or Value.IsType<RawByteString> or Value.IsType<UTF8String> then
        begin
          PreDecl:=PreDecl+Key+' db '+#39+Value.AsType<AnsiString>+#39+',0'+sLineBreak;
          inc(base,length(Value.AsType<AnsiString>));
        end
        else if Value.IsType<ShortString> then
        begin
          PreDecl:=PreDecl+Key+' db '+#39+Value.AsType<ShortString>+#39+',0'+sLineBreak;
          inc(base,length(Value.AsType<ShortString>));
        end
        else if Value.IsType<WideString> then
        begin
          PreDecl:=PreDecl+Key+' db ';
          p0:=Pointer(PWideChar(Value.AsType<WideString>));
          for i:={$IFDEF NEXTGEN}0{$ELSE}1{$ENDIF} to length(Value.AsType<WideString>){$IFDEF NEXTGEN}-1{$ENDIF} do
          begin
            PreDecl:=PreDecl+inttostr(p0^)+',';
            inc(p0);
            PreDecl:=PreDecl+inttostr(p0^)+',';
            inc(p0);
          end;
          PreDecl:=PreDecl+'0,0'+sLineBreak;
          inc(base,length(Value.AsType<WideString>)*2);
        end
        else if Value.IsType<UCS4String> then
        begin
          PreDecl:=PreDecl+Key+' db ';
          p0:=Pointer(PWideChar(Value.AsType<UCS4String>));
          for i:={$IFDEF NEXTGEN}0{$ELSE}1{$ENDIF} to length(Value.AsType<UCS4String>){$IFDEF NEXTGEN}-1{$ENDIF} do
          begin
            PreDecl:=PreDecl+inttostr(p0^)+',';
            inc(p0);
            PreDecl:=PreDecl+inttostr(p0^)+',';
            inc(p0);
            PreDecl:=PreDecl+inttostr(p0^)+',';
            inc(p0);
            PreDecl:=PreDecl+inttostr(p0^)+',';
            inc(p0);
          end;
          PreDecl:=PreDecl+'0,0,0,0'+sLineBreak;
          inc(base,length(Value.AsType<UCS4String>)*4);
        end
        else if Value.IsOrdinal then
        begin
          case Value.DataSize of
          1:PreDecl:=PreDecl+Key+' db '+Value.AsOrdinal.ToString+sLineBreak;
          2:PreDecl:=PreDecl+Key+' dw '+Value.AsOrdinal.ToString+sLineBreak;
          4:PreDecl:=PreDecl+Key+' dd '+Value.AsOrdinal.ToString+sLineBreak;
          8:PreDecl:=PreDecl+Key+' dq '+Value.AsOrdinal.ToString+sLineBreak;
          end;
          inc(base,Value.DataSize);
        end
        else if Value.Kind=tkFloat then
        begin
          if Value.IsType<Single> then
            PreDecl:=PreDecl+Key+' dd '+FloatToStrF(Value.AsType<Single>,ffFixed,1000,1000)+sLineBreak
          else if Value.IsType<Double> then
            PreDecl:=PreDecl+Key+' dq '+FloatToStrF(Value.AsType<Double>,ffFixed,1000,1000)+sLineBreak
          else if Value.IsType<Extended> then
            PreDecl:=PreDecl+Key+{$IF 8=SizeOf(Extended)}' dq '{$ELSEIF 10=SizeOf(Extended)}' dt '{$ELSE}' ddq '{$IFEND}+FloatToStrF(Value.AsType<Extended>,ffFixed,1000,1000)+sLineBreak
          else if Value.IsType<Real> then
            PreDecl:=PreDecl+Key+' dq '+FloatToStrF(Value.AsType<Real>,ffFixed,1000,1000)+sLineBreak
          else if Value.IsType<Real48> then
            PreDecl:=PreDecl+Key+' df '+FloatToStrF(Value.AsType<Real48>,ffFixed,1000,1000)+sLineBreak
          else if Value.IsType<Comp> then
            PreDecl:=PreDecl+Key+' dq '+FloatToStrF(Value.AsType<Comp>,ffFixed,1000,1000)+sLineBreak
          else if Value.IsType<Currency> then
            PreDecl:=PreDecl+Key+' dq '+FloatToStrF(Value.AsType<Currency>,ffFixed,1000,1000)+sLineBreak
          else
            PreDecl:=PreDecl+Key+' dd 0.0'+sLineBreak;
        end
        else if Value.Kind=tkPointer then
        begin
          case SizeOf(pointer) of
          2:PreDecl:=PreDecl+Key+' dw '+NativeUInt(Value.AsType<Pointer>).ToString+sLineBreak;
          4:PreDecl:=PreDecl+Key+' dd '+NativeUInt(Value.AsType<Pointer>).ToString+sLineBreak;
          8:PreDecl:=PreDecl+Key+' dq '+NativeUInt(Value.AsType<Pointer>).ToString+sLineBreak;
          end;
          inc(base,SizeOf(pointer));
        end
        else if Value.IsArray then
        begin
          if Value.GetArrayLength=0 then
          begin
            PreDecl:=PreDecl+Key+' equ 0'+sLineBreak;
          end
          else
          begin
            PreDecl:=PreDecl+Key+':'+sLineBreak;
            for i:=0 to Value.GetArrayLength-1 do
              VarParse(key+'.i'+i.ToString,Value.GetArrayElement(i),PreDecl,Base);
          end;
        end
        else if Value.Kind=tkRecord or Value.IsClass  then
        begin
          PreDecl:=PreDecl+Key+':'+sLineBreak;
          for rfield in TRTTIContext.Create.GetType(Value.TypeInfo).GetFields do
            VarParse(key+'.'+rfield.Name,rfield.GetValue(@Value),PreDecl,base);
          for rmetod in TRTTIContext.Create.GetType(Value.TypeInfo).GetMethods do
          begin
            PreDecl:=PreDecl+key+'.'+rmetod.Name+' dd '+NativeUInt(rmetod.CodeAddress).ToString;
            case SizeOf(pointer) of
            2:PreDecl:=PreDecl+Key+' dw '+NativeUInt(Value.AsType<Pointer>).ToString+sLineBreak;
            4:PreDecl:=PreDecl+Key+' dd '+NativeUInt(Value.AsType<Pointer>).ToString+sLineBreak;
            8:PreDecl:=PreDecl+Key+' dq '+NativeUInt(Value.AsType<Pointer>).ToString+sLineBreak;
            end;
            inc(base,SizeOf(pointer));
          end;
        end
        else //if Value.Kind=tkUnknown then
          PreDecl:=PreDecl+Key+': times '+ Value.DataSize.ToString+' db 0'+sLineBreak;
  end;
  procedure ConstParse(key:string;value:TValue;var PreDecl:string;var base:NativeUInt);
  var
    i:NativeUInt;
    p0:PByte;
  begin
        if Value.IsType<AnsiString> or Value.IsType<RawByteString> or Value.IsType<UTF8String> then
        begin
          PreDecl:=PreDecl+Key+' db '+#39+Value.AsType<AnsiString>+#39+',0'+sLineBreak;
          inc(base,length(Value.AsType<AnsiString>));
        end
        else if Value.IsType<ShortString> then
        begin
          PreDecl:=PreDecl+Key+' db '+#39+Value.AsType<ShortString>+#39+',0'+sLineBreak;
          inc(base,length(Value.AsType<ShortString>));
        end
        else if Value.IsType<WideString> then
        begin
          PreDecl:=PreDecl+Key+' db ';
          p0:=Pointer(PWideChar(Value.AsType<WideString>));
          for i:={$IFDEF NEXTGEN}0{$ELSE}1{$ENDIF} to length(Value.AsType<WideString>){$IFDEF NEXTGEN}-1{$ENDIF} do
          begin
            PreDecl:=PreDecl+inttostr(p0^)+',';
            inc(p0);
            PreDecl:=PreDecl+inttostr(p0^)+',';
            inc(p0);
          end;
          PreDecl:=PreDecl+'0,0'+sLineBreak;
          inc(base,length(Value.AsType<WideString>)*2);
        end
        else if Value.IsType<UCS4String> then
        begin
          PreDecl:=PreDecl+Key+' db ';
          p0:=Pointer(PWideChar(Value.AsType<UCS4String>));
          for i:={$IFDEF NEXTGEN}0{$ELSE}1{$ENDIF} to length(Value.AsType<UCS4String>){$IFDEF NEXTGEN}-1{$ENDIF} do
          begin
            PreDecl:=PreDecl+inttostr(p0^)+',';
            inc(p0);
            PreDecl:=PreDecl+inttostr(p0^)+',';
            inc(p0);
            PreDecl:=PreDecl+inttostr(p0^)+',';
            inc(p0);
            PreDecl:=PreDecl+inttostr(p0^)+',';
            inc(p0);
          end;
          PreDecl:=PreDecl+'0,0,0,0'+sLineBreak;
          inc(base,length(Value.AsType<UCS4String>)*4);
        end
        else if Value.IsOrdinal then
          PreDecl:=PreDecl+Key+' equ '+Value.AsOrdinal.ToString+sLineBreak
        else if Value.Kind=tkFloat then
        begin
          if Value.IsType<Single> then
            PreDecl:=PreDecl+Key+' equ '+FloatToStrF(Value.AsType<Single>,ffFixed,1000,1000)+sLineBreak
          else if Value.IsType<Double> then
            PreDecl:=PreDecl+Key+' equ '+FloatToStrF(Value.AsType<Double>,ffFixed,1000,1000)+sLineBreak
          else if Value.IsType<Extended> then
            PreDecl:=PreDecl+Key+' equ '+FloatToStrF(Value.AsType<Extended>,ffFixed,1000,1000)+sLineBreak
          else if Value.IsType<Real> then
            PreDecl:=PreDecl+Key+' equ '+FloatToStrF(Value.AsType<Real>,ffFixed,1000,1000)+sLineBreak
          else if Value.IsType<Real48> then
            PreDecl:=PreDecl+Key+' equ '+FloatToStrF(Value.AsType<Real48>,ffFixed,1000,1000)+sLineBreak
          else if Value.IsType<Comp> then
            PreDecl:=PreDecl+Key+' equ '+FloatToStrF(Value.AsType<Comp>,ffFixed,1000,1000)+sLineBreak
          else if Value.IsType<Currency> then
            PreDecl:=PreDecl+Key+' equ '+FloatToStrF(Value.AsType<Currency>,ffFixed,1000,1000)+sLineBreak
          else
            PreDecl:=PreDecl+Key+' equ 0.0'+sLineBreak;
        end
        else if Value.Kind=tkPointer then
          PreDecl:=PreDecl+Key+' equ '+NativeUInt(Value.AsType<Pointer>).ToString+sLineBreak
        else if Value.IsArray then
        begin
          if Value.GetArrayLength=0 then
          begin
            PreDecl:=PreDecl+Key+' equ 0'+sLineBreak;
          end
          else
          begin
            PreDecl:=PreDecl+Key+':'+sLineBreak;
            for i:=0 to Value.GetArrayLength-1 do
              VarParse(key+'.i'+i.ToString,Value.GetArrayElement(i),PreDecl,Base);
          end;
        end
        else
          VarParse(key,Value,PreDecl,Base);
  end;
var
  pointerDecl,PreDecl:string;
  Res:TFasmResult;
  i,base,sb:NativeUInt;
  FuncDict:TDictionary<string,NativeUInt>;
  RegVarDict:TDictionary<string,TPair<NativeUInt,PTypeInfo>>;
  p:pointer;
begin
sb:=(Compiler as TRTBFasmCompiler).CompilerMem;
p:=VirtualAlloc(nil,sb,MEM_COMMIT,PAGE_EXECUTE_READWRITE);
case SizeOf(pointer)of
2:pointerDecl:='dw ';
4:pointerDecl:='dd ';
8:pointerDecl:='dq ';
end;
PreDecl:='use32'+sLineBreak;
FuncDict:=TDictionary<string,NativeUInt>.Create();
base:=0;
with funcs do
  if Count<>0 then
    for i:=0 to Count-1 do
    begin
      PreDecl:=PreDecl+pointerDecl+Strings[i]+sLineBreak;
      FuncDict.Add(Strings[i],base);
      inc(base,SizeOf(pointer));
    end;
RegVarDict:=TDictionary<string,TPair<NativeUInt,PTypeInfo>>.Create();
with regvars do
  if Count<>0 then
    for i:=0 to Count-1 do
    begin
      PreDecl:=PreDecl+pointerDecl+Items[i].Key+sLineBreak;
      RegVarDict.Add(Items[i].Key,TPair<NativeUInt,PTypeInfo>.Create(base,Items[i].Value));
      inc(base,SizeOf(pointer));
    end;
with consts do
  if Count<>0 then
    for i:=0 to Count-1 do
      with Items[i] do
        ConstParse(Key,Value,PreDecl,base);
if callbacks.Count<>0 then
  for i:=0 to callbacks.Count-1 do
    PreDecl:=PreDecl+callbacks[i].Key+':'+sLineBreak+
             {$IFDEF CPU32BITS}'pop eax'{$ELSE}'pop rax'{$ENDIF}+sLineBreak+
             {$IFDEF CPU32BITS}'push dword '{$ELSE}'push qword '{$ENDIF}+i.ToString+sLineBreak+
             {$IFDEF CPU32BITS}'push dword '{$ELSE}'push qword '{$ENDIF}+NativeUint(pointer(callbacks)).ToString+sLineBreak+
             {$IFDEF CPU32BITS}'push eax'{$ELSE}'push rax'{$ENDIF}+sLineBreak+
             {$IFDEF CPU32BITS}'jmp dword '{$ELSE}'jmp qword '{$ENDIF}+NativeUint(@CallBackCall).ToString+sLineBreak;
Res:=FasmAssemble('org '+NativeUInt(p).ToString+sLineBreak+PreDecl+Text+GetIncLibs,sb,(Compiler as TRTBFasmCompiler).MaxSteps);
if Res.Error<>FASM_OK then
begin
  VirtualFree(p,sb,MEM_RELEASE);
  raise Exception.Create(Res.OutStr);
end;
VirtualAlloc(p,Res.sb,MEM_COMMIT,PAGE_EXECUTE_READWRITE);
CopyMemory(p,Res.OutData,Res.sb);
FreeMem(Res.OutData);
Result:=TRTBFasmModule.Create(p,Res.sb,FuncDict,RegVarDict);
p:=nil;
end;

destructor TRTBFasmCompiler.TRTBFasmSource.Destroy;
begin
FreeAndNil(libs);
FreeAndNil(funcs);
FreeAndNil(regvars);
FreeAndNil(consts);
end;

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

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

end.