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

Update Fasm Implementation

Browse Source
This commit is contained in:
Artem3213212
2018-05-01 22:03:01 +03:00
parent a01fd8c1ea
commit 512e9c9d04
2 changed files with 122 additions and 10 deletions
Download Patch File Download Diff File Expand all files Collapse all files

128
Source/RuntimeBuilder.Fasm.pas
View File

@@ -68,9 +68,9 @@ type
procedure AddConst(NameSpace:string;Name:string;Val:TValue);override; procedure AddConst(NameSpace:string;Name:string;Val:TValue);override;
procedure DelConst(NameSpace:string;Name:string);override; procedure DelConst(NameSpace:string;Name:string);override;
{procedure AddVariable(NameSpace:string;Name:string;var Data);override; procedure AddVariable(NameSpace:string;Name:string;var Data);override;
procedure ExportVariable(NameSpace:string;Name:string;var Data);override; procedure ExportVariable(NameSpace:string;Name:string;var Data);override;
procedure DelVariable(NameSpace:string;Name:string);override;} procedure DelVariable(NameSpace:string;Name:string);override;
procedure &Register(NameSpace:string;Name:string;&Type:TRTBType);override; procedure &Register(NameSpace:string;Name:string;&Type:TRTBType);override;
procedure UnRegister(NameSpace:string;Name:string);override; procedure UnRegister(NameSpace:string;Name:string);override;
@@ -277,6 +277,27 @@ if consts.Count<>0 then
end; end;
end; end;
procedure TRTBFasmCompiler.TRTBFasmSource.AddVariable(NameSpace:string;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(NameSpace:string;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(NameSpace:string;Name:string);
begin
DelConst(NameSpace,Name);
end;
procedure TRTBFasmCompiler.TRTBFasmSource.&Register(NameSpace:string;Name:string;&Type:TRTBType); procedure TRTBFasmCompiler.TRTBFasmSource.&Register(NameSpace:string;Name:string;&Type:TRTBType);
begin begin
if NameSpace<>'' then if NameSpace<>'' then
@@ -319,6 +340,103 @@ with funcs do
end; end;
function TRTBFasmCompiler.TRTBFasmSource.Compilate:TRTBModule; function TRTBFasmCompiler.TRTBFasmSource.Compilate:TRTBModule;
procedure VarParse(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
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
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
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 if Value.Kind=tkRecord then
begin
PreDecl:=PreDecl+Key+':'+sLineBreak;
for i:=1 to Value.TypeData.ManagedFldCount do
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); procedure ConstParse(key:string;value:TValue;var PreDecl:string;var base:NativeUInt);
var var
i:NativeUInt; i:NativeUInt;
@@ -399,12 +517,10 @@ function TRTBFasmCompiler.TRTBFasmSource.Compilate:TRTBModule;
begin begin
PreDecl:=PreDecl+Key+':'+sLineBreak; PreDecl:=PreDecl+Key+':'+sLineBreak;
for i:=0 to Value.GetArrayLength-1 do for i:=0 to Value.GetArrayLength-1 do
ConstParse(key+'.i'+i.ToString,Value.GetArrayElement(i),PreDecl,Base); VarParse(key+'.i'+i.ToString,Value.GetArrayElement(i),PreDecl,Base);
end; end;
end end
else if Value.Kind=tkRecord then else //if Value.Kind=tkUnknown then
else if Value.Kind=tkUnknown then
PreDecl:=PreDecl+Key+' equ 0'+sLineBreak; PreDecl:=PreDecl+Key+' equ 0'+sLineBreak;
end; end;
var var

4
Tests/Unit1.pas
View File

@@ -36,15 +36,11 @@ Module:=Src.Compilate;
Func1:=Module.Funtion['main']; Func1:=Module.Funtion['main'];
Func2:=Module.Funtion['varmain']; Func2:=Module.Funtion['varmain'];
if 454<>Func1.Call(TypeInfo(integer),[454],CRTBCallTypeStdCall).AsInteger then if 454<>Func1.Call(TypeInfo(integer),[454],CRTBCallTypeStdCall).AsInteger then
begin
raise Exception.Create('Error in test1'); raise Exception.Create('Error in test1');
end;
Var1:=Module.&Var['Pmain']; Var1:=Module.&Var['Pmain'];
Var1.Val:=424; Var1.Val:=424;
if Var1.Val.AsInteger<>Func2.Call(TypeInfo(integer),[],CRTBCallTypeStdCall).AsInteger then if Var1.Val.AsInteger<>Func2.Call(TypeInfo(integer),[],CRTBCallTypeStdCall).AsInteger then
begin
raise Exception.Create('Error in test1'); raise Exception.Create('Error in test1');
end;
FreeAndNil(Func1); FreeAndNil(Func1);
FreeAndNil(Src); FreeAndNil(Src);
FreeAndNil(Fasm); FreeAndNil(Fasm);