Mem problems fix

This commit is contained in:
2018-04-13 00:31:35 +03:00
parent 46952fd74d
commit 3aadfb6212
2 changed files with 71 additions and 19 deletions

View File

@@ -21,21 +21,25 @@ type
public
constructor Create(p:Pointer);
function Call(OutType:PTypeInfo;args:TArray<TValue>;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;override;
destructor Destroy;override;
end;
{TRTBFasmVar=class(TRTBVar)
TRTBFasmVar=class(TRTBVar)
protected
function SetVal(Val:TValue);virtual;abstract;
function GetVal:TValue;virtual;abstract;
p:pointer;
&Type:TRTBType;
procedure SetVal(Val:TValue);override;
//function GetVal:TValue;override;
public
property Val:TValue read GetVal write SetVal;
end;}
constructor Create(p:pointer;&Type:TRTBType);
destructor Destroy;override;
end;
private
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;}
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;
@@ -109,7 +113,30 @@ end;
{$ENDIF}
end;
(*constructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmLib.TRTBFasmLibFunc.Create(p:Pointer);
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;
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;
{constructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmLib.TRTBFasmLibFunc.Create(p:Pointer);
begin
Self.p:=p;
end;
@@ -122,21 +149,24 @@ end;
function TRTBFasmCompiler.TRTBFasmSource.TRTBFasmLib.GetFuntion(Name:string):TRTBFunc;
begin
Result:=TRTBFasmLibFunc.Create(GetProcAddress(Lib,pwidechar(Name)));
end;*)
end;}
function TRTBFasmCompiler.TRTBFasmSource.TRTBFasmModule.GetFuntion(Name:string):TRTBFunc;
begin
Result:=TRTBFasmFunc.Create(Pointer(PNativeUInt(NativeUInt(funcs.Items[Name])+NativeUInt(p))^+NativeUInt(p)));
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:=VirtualAlloc(nil,sb,MEM_COMMIT,PAGE_EXECUTE_READWRITE);
CopyMemory(Self.p,p,sb);
Self.p:=p;
Self.sb:=sb;
Self.funcs:=funcs;
Self.regvars:=regvars;
FreeMem(p);
end;
destructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmModule.Destroy;
@@ -222,9 +252,10 @@ function TRTBFasmCompiler.TRTBFasmSource.Compilate:TRTBModule;
var
templib,pointerDecl,PreDecl:string;
Res:TFasmResult;
i,base:NativeUInt;
i,base,sb:NativeUInt;
FuncDict:TDictionary<string,NativeUInt>;
RegVarDict:TDictionary<string,TPair<NativeUInt,PTypeInfo>>;
p:pointer;
begin
case SizeOf(pointer)of
2:pointerDecl:='dw ';
@@ -249,10 +280,21 @@ with regvars do
PreDecl:=PreDecl+pointerDecl+Items[i].Key+sLineBreak;
RegVarDict.Add(Items[i].Key,TPair<NativeUInt,PTypeInfo>.Create(base+i*SizeOf(pointer),Items[i].Value));
end;
Res:=FasmAssemble(PreDecl+Text+GetIncLibs,(Compiler as TRTBFasmCompiler).CompilerMem,(Compiler as TRTBFasmCompiler).MaxSteps);
sb:=(Compiler as TRTBFasmCompiler).CompilerMem;
p:=VirtualAlloc(nil,sb,MEM_COMMIT,PAGE_EXECUTE_READWRITE);
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);
Result:=TRTBFasmModule.Create(Res.OutData,Res.sb,FuncDict,RegVarDict);
end;
//VirtualFree(p,sb,MEM_RELEASE);
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;

View File

@@ -22,19 +22,29 @@ var
Fasm:TRTBFasmCompiler;
Src:TRTBSource;
Module:TRTBModule;
Func1:TRTBFunc;
Func1,Func2:TRTBFunc;
Var1:TRTBVar;
begin
Fasm:=TRTBFasmCompiler.Create('..\..\..\lib\FasmOnDelphi\fasmw172\fasm');
Src:=Fasm.GenNewSrc;
Src.Text:='use32'+sLineBreak+'main:'+sLineBreak+'pop ecx'+sLineBreak+'pop eax'+sLineBreak+'jmp ecx'+sLineBreak+'Pmain dd 0';
Src.Text:='use32'+sLineBreak+'main:'+sLineBreak+'pop ecx'+sLineBreak+'pop eax'+sLineBreak+'jmp ecx'+sLineBreak+'Pmain dd 0'+
sLineBreak+'varmain:'+sLineBreak+'mov eax,[Pmain]'+sLineBreak+'ret';
Src.RegisterFunction('','main');
Src.Register('','Pmain',TypeInfo(pointer));
Src.RegisterFunction('','varmain');
Src.Register('','Pmain',TypeInfo(integer));
Module:=Src.Compilate;
Func1:=Module.Funtion['main'];
Func2:=Module.Funtion['varmain'];
if 454<>Func1.Call(TypeInfo(integer),[454],CRTBCallTypeStdCall).AsInteger then
begin
raise Exception.Create('Error in test1');
end;
Var1:=Module.&Var['Pmain'];
Var1.Val:=454;
if 454<>Func2.Call(TypeInfo(integer),[],CRTBCallTypeStdCall).AsInteger then
begin
raise Exception.Create('Error in test1');
end;
FreeAndNil(Func1);
FreeAndNil(Src);
FreeAndNil(Fasm);