artem3213212/RuntimeBuilder
1
0
Fork 0
Code Issues 1 Pull Requests Releases Wiki Activity

Fix abstract fasm part

Browse Source
This commit is contained in:
Artem3213212
2018-04-13 09:38:20 +03:00
parent 3aadfb6212
commit c3e9de4bf9
3 changed files with 39 additions and 36 deletions
Download Patch File Download Diff File Expand all files Collapse all files

45
Source/RuntimeBuilder.Fasm.pas
View File

@@ -28,7 +28,7 @@ type
p:pointer; p:pointer;
&Type:TRTBType; &Type:TRTBType;
procedure SetVal(Val:TValue);override; procedure SetVal(Val:TValue);override;
//function GetVal:TValue;override; function GetVal:TValue;override;
public public
constructor Create(p:pointer;&Type:TRTBType); constructor Create(p:pointer;&Type:TRTBType);
destructor Destroy;override; destructor Destroy;override;
@@ -55,7 +55,7 @@ type
public public
constructor Create(Compiler:TRTBFasmCompiler); constructor Create(Compiler:TRTBFasmCompiler);
{procedure LoadLib(Name:string);override; procedure LoadLib(Name:string);override;
procedure UnLoadLib(Name:string);override; procedure UnLoadLib(Name:string);override;
procedure AddNameSpace(Name:string);override; procedure AddNameSpace(Name:string);override;
@@ -65,7 +65,7 @@ type
procedure ExportType(NameSpace:string;Name:string;&Type:TRTBType);override; procedure ExportType(NameSpace:string;Name:string;&Type:TRTBType);override;
procedure DelType(NameSpace:string;Name:string);override; procedure DelType(NameSpace:string;Name:string);override;
procedure AddConst(NameSpace:string;Name:string;Val:TValue);override; {procedure AddConst(NameSpace:string;Name:string;Val:TValue);override;
procedure ExportConst(NameSpace:string;Name:string;Val:TValue);override; procedure ExportConst(NameSpace:string;Name:string;Val:TValue);override;
procedure DelConst(NameSpace:string;Name:string);override; procedure DelConst(NameSpace:string;Name:string);override;
@@ -124,6 +124,11 @@ if Val.TypeInfo=&Type then
Val.ExtractRawData(p); Val.ExtractRawData(p);
end; 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); constructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmModule.TRTBFasmVar.Create(p:pointer;&Type:TRTBType);
begin begin
Self.p:=p; Self.p:=p;
@@ -202,10 +207,36 @@ funcs:=TStringList.Create;
regvars:=TList<TPair<string,PTypeInfo>>.Create; regvars:=TList<TPair<string,PTypeInfo>>.Create;
end; end;
{function TRTBFasmCompiler.TRTBFasmSource.LoadLib(Name:string):TRTBLib; procedure TRTBFasmCompiler.TRTBFasmSource.LoadLib(Name:string);
begin begin
libs.Add(Name); libs.Add(Name);
end;} end;
procedure TRTBFasmCompiler.TRTBFasmSource.UnLoadLib(Name:string);
begin
with libs do
Delete(IndexOf(Name));
end;
procedure TRTBFasmCompiler.TRTBFasmSource.AddNameSpace(Name:string);
begin
end;
procedure TRTBFasmCompiler.TRTBFasmSource.DelNameSpace(Name:string);
begin
end;
procedure TRTBFasmCompiler.TRTBFasmSource.AddType(NameSpace:string;Name:string;&Type:TRTBType);
begin
end;
procedure ExportType(NameSpace:string;Name:string;&Type:TRTBType);
begin
end;
procedure DelType(NameSpace:string;Name:string);
begin
end;
procedure TRTBFasmCompiler.TRTBFasmSource.&Register(NameSpace:string;Name:string;&Type:TRTBType); procedure TRTBFasmCompiler.TRTBFasmSource.&Register(NameSpace:string;Name:string;&Type:TRTBType);
begin begin
@@ -282,14 +313,12 @@ with regvars do
end; end;
sb:=(Compiler as TRTBFasmCompiler).CompilerMem; sb:=(Compiler as TRTBFasmCompiler).CompilerMem;
p:=VirtualAlloc(nil,sb,MEM_COMMIT,PAGE_EXECUTE_READWRITE); p:=VirtualAlloc(nil,sb,MEM_COMMIT,PAGE_EXECUTE_READWRITE);
Res:=FasmAssemble('org '+NativeUint(p).ToString+ Res:=FasmAssemble('org '+NativeUint(p).ToString+sLineBreak+PreDecl+Text+GetIncLibs,sb,(Compiler as TRTBFasmCompiler).MaxSteps);
sLineBreak+PreDecl+Text+GetIncLibs,sb,(Compiler as TRTBFasmCompiler).MaxSteps);
if Res.Error<>FASM_OK then if Res.Error<>FASM_OK then
begin begin
VirtualFree(p,sb,MEM_RELEASE); VirtualFree(p,sb,MEM_RELEASE);
raise Exception.Create(Res.OutStr); raise Exception.Create(Res.OutStr);
end; end;
//VirtualFree(p,sb,MEM_RELEASE);
VirtualAlloc(p,Res.sb,MEM_COMMIT,PAGE_EXECUTE_READWRITE); VirtualAlloc(p,Res.sb,MEM_COMMIT,PAGE_EXECUTE_READWRITE);
CopyMemory(p,Res.OutData,Res.sb); CopyMemory(p,Res.OutData,Res.sb);
FreeMem(Res.OutData); FreeMem(Res.OutData);

4
Tests/Unit1.pas
View File

@@ -40,8 +40,8 @@ begin
raise Exception.Create('Error in test1'); raise Exception.Create('Error in test1');
end; end;
Var1:=Module.&Var['Pmain']; Var1:=Module.&Var['Pmain'];
Var1.Val:=454; Var1.Val:=424;
if 454<>Func2.Call(TypeInfo(integer),[],CRTBCallTypeStdCall).AsInteger then if Var1.Val.AsInteger<>Func2.Call(TypeInfo(integer),[],CRTBCallTypeStdCall).AsInteger then
begin begin
raise Exception.Create('Error in test1'); raise Exception.Create('Error in test1');
end; end;

26
Tests/Win64/Debug/dunitx-results.xml
View File

@@ -1,26 +0,0 @@
<?xml version="1.0" encoding="UTF-8" standalone="yes" ?>
<test-results name="W:\RuntimeBuilder\Tests\Win64\Debug\Project2.exe" total="1" errors="1" failures="0" ignored="0" inconclusive="0" not-run="0" skipped="0" invalid="0" date="2018-03-24" time="0.045">
<culture-info current-culture="en" current-uiculture="en" />
<test-suite type="Assembly" name="Project2.exe" executed="true" result="Failure" success="False" time="0.045" asserts="0">
<results>
<test-suite type="Namespace" name="Unit1" executed="true" result="Success" success="True" time="0.045" asserts="0" >
<results>
<test-suite type="Fixture" name="TRuntimeBuilderTestObject" executed="True" result="Success" success="True" time="0.045" >
<results>
<test-case name="Test1." executed="True" result="Error" success="False" time="0.045" asserts="0" >
<failure>
<message>
<![CDATA[ 2 ]]>
</message>
<stack-trace>
<![CDATA[ ]]>
</stack-trace>
</failure>
</test-case>
</results>
</test-suite>
</results>
</test-suite>
</results>
</test-suite>
</test-results>