Fix abstract fasm part

This commit is contained in:
2018-04-13 09:38:20 +03:00
parent 3aadfb6212
commit c3e9de4bf9
3 changed files with 39 additions and 36 deletions

View File

@@ -28,7 +28,7 @@ type
p:pointer;
&Type:TRTBType;
procedure SetVal(Val:TValue);override;
//function GetVal:TValue;override;
function GetVal:TValue;override;
public
constructor Create(p:pointer;&Type:TRTBType);
destructor Destroy;override;
@@ -55,7 +55,7 @@ type
public
constructor Create(Compiler:TRTBFasmCompiler);
{procedure LoadLib(Name:string);override;
procedure LoadLib(Name:string);override;
procedure UnLoadLib(Name:string);override;
procedure AddNameSpace(Name:string);override;
@@ -65,7 +65,7 @@ type
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 AddConst(NameSpace:string;Name:string;Val:TValue);override;
procedure ExportConst(NameSpace:string;Name:string;Val:TValue);override;
procedure DelConst(NameSpace:string;Name:string);override;
@@ -124,6 +124,11 @@ 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;
@@ -202,10 +207,36 @@ funcs:=TStringList.Create;
regvars:=TList<TPair<string,PTypeInfo>>.Create;
end;
{function TRTBFasmCompiler.TRTBFasmSource.LoadLib(Name:string):TRTBLib;
procedure TRTBFasmCompiler.TRTBFasmSource.LoadLib(Name:string);
begin
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);
begin
@@ -282,14 +313,12 @@ with regvars do
end;
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);
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;
//VirtualFree(p,sb,MEM_RELEASE);
VirtualAlloc(p,Res.sb,MEM_COMMIT,PAGE_EXECUTE_READWRITE);
CopyMemory(p,Res.OutData,Res.sb);
FreeMem(Res.OutData);

View File

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

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>