Fix abstract fasm part
This commit is contained in:
@@ -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);
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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>
|
||||
Reference in New Issue
Block a user