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-04-15 19:22:03 +03:00
parent b2702114a5
commit a01fd8c1ea
2 changed files with 166 additions and 10 deletions
Download Patch File Download Diff File Expand all files Collapse all files

172
Source/RuntimeBuilder.Fasm.pas
View File

@@ -48,6 +48,7 @@ type
libs:TStringList;
funcs:TStringList;
regvars:TList<TPair<string,PTypeInfo>>;
consts:TList<TPair<string,TValue>>;
FText:string;
function GetIncLibs():string;
function GetText:string;override;
@@ -64,10 +65,10 @@ type
procedure AddType(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 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 DelVariable(NameSpace:string;Name:string);override;}
@@ -188,6 +189,7 @@ FText:='';
libs:=TStringList.Create;
funcs:=TStringList.Create;
regvars:=TList<TPair<string,PTypeInfo>>.Create;
consts:=TList<TPair<string,TValue>>.Create;
end;
procedure TRTBFasmCompiler.TRTBFasmSource.LoadLib(Name:string);
@@ -206,7 +208,42 @@ begin
end;
procedure TRTBFasmCompiler.TRTBFasmSource.DelNameSpace(Name:string);
label
funcscontinue,regvarscontinue,constscontinue;
var
i,i0:NativeUInt;
begin
Name:=Name+'.';
i:=0;
while i<funcs.Count do
begin
for i0:=1 to length(Name) do
if funcs.Strings[i][i0]=Name[i0]then
goto funcscontinue;
funcs.Delete(i);
inc(i);
funcscontinue:
end;
i:=0;
while i<regvars.Count do
begin
for i0:=1 to length(Name) do
if regvars.Items[i].Key[i0]=Name[i0]then
goto regvarscontinue;
regvars.Delete(i);
inc(i);
regvarscontinue:
end;
i:=0;
while i<consts.Count do
begin
for i0:=1 to length(Name) do
if consts.Items[i].Key[i0]=Name[i0]then
goto constscontinue;
consts.Delete(i);
inc(i);
constscontinue:
end;
end;
procedure TRTBFasmCompiler.TRTBFasmSource.AddType(NameSpace:string;Name:string;&Type:TRTBType);
@@ -217,6 +254,29 @@ procedure TRTBFasmCompiler.TRTBFasmSource.DelType(NameSpace:string;Name:string);
begin
end;
procedure TRTBFasmCompiler.TRTBFasmSource.AddConst(NameSpace:string;Name:string;Val:TValue);
begin
if NameSpace<>'' then
consts.Add(TPair<string,TValue>.Create(NameSpace+'.'+Name,Val))
else
consts.Add(TPair<string,TValue>.Create(Name,Val));
end;
procedure TRTBFasmCompiler.TRTBFasmSource.DelConst(NameSpace:string;Name:string);
var
i:NativeUInt;
begin
if NameSpace<>'' then
Name:=NameSpace+'.'+Name;
if consts.Count<>0 then
for i:=0 to consts.Count-1 do
if consts.Items[i].Key=Name then
begin
consts.Delete(i);
Break;
end;
end;
procedure TRTBFasmCompiler.TRTBFasmSource.&Register(NameSpace:string;Name:string;&Type:TRTBType);
begin
if NameSpace<>'' then
@@ -259,6 +319,94 @@ with funcs do
end;
function TRTBFasmCompiler.TRTBFasmSource.Compilate:TRTBModule;
procedure ConstParse(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
PreDecl:=PreDecl+Key+' equ '+Value.AsOrdinal.ToString+sLineBreak
else if Value.Kind=tkFloat then
begin
if Value.IsType<Single> then
PreDecl:=PreDecl+Key+' equ '+FloatToStrF(Value.AsType<Single>,ffFixed,1000,1000)+sLineBreak
else if Value.IsType<Double> then
PreDecl:=PreDecl+Key+' equ '+FloatToStrF(Value.AsType<Double>,ffFixed,1000,1000)+sLineBreak
else if Value.IsType<Extended> then
PreDecl:=PreDecl+Key+' equ '+FloatToStrF(Value.AsType<Extended>,ffFixed,1000,1000)+sLineBreak
else if Value.IsType<Real> then
PreDecl:=PreDecl+Key+' equ '+FloatToStrF(Value.AsType<Real>,ffFixed,1000,1000)+sLineBreak
else if Value.IsType<Real48> then
PreDecl:=PreDecl+Key+' equ '+FloatToStrF(Value.AsType<Real48>,ffFixed,1000,1000)+sLineBreak
else if Value.IsType<Comp> then
PreDecl:=PreDecl+Key+' equ '+FloatToStrF(Value.AsType<Comp>,ffFixed,1000,1000)+sLineBreak
else if Value.IsType<Currency> then
PreDecl:=PreDecl+Key+' equ '+FloatToStrF(Value.AsType<Currency>,ffFixed,1000,1000)+sLineBreak
else
PreDecl:=PreDecl+Key+' equ 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
ConstParse(key+'.i'+i.ToString,Value.GetArrayElement(i),PreDecl,Base);
end;
end
else if Value.Kind=tkRecord then
else if Value.Kind=tkUnknown then
PreDecl:=PreDecl+Key+' equ 0'+sLineBreak;
end;
var
templib,pointerDecl,PreDecl:string;
Res:TFasmResult;
@@ -267,6 +415,8 @@ var
RegVarDict:TDictionary<string,TPair<NativeUInt,PTypeInfo>>;
p:pointer;
begin
sb:=(Compiler as TRTBFasmCompiler).CompilerMem;
p:=VirtualAlloc(nil,sb,MEM_COMMIT,PAGE_EXECUTE_READWRITE);
case SizeOf(pointer)of
2:pointerDecl:='dw ';
4:pointerDecl:='dd ';
@@ -274,25 +424,30 @@ case SizeOf(pointer)of
end;
PreDecl:='';
FuncDict:=TDictionary<string,NativeUInt>.Create();
base:=0;
with funcs do
if Count<>0 then
for i:=0 to Count-1 do
begin
PreDecl:=PreDecl+pointerDecl+Strings[i]+sLineBreak;
FuncDict.Add(Strings[i],i*SizeOf(pointer));
FuncDict.Add(Strings[i],base);
inc(base,SizeOf(pointer));
end;
base:=SizeOf(pointer)*funcs.Count;
RegVarDict:=TDictionary<string,TPair<NativeUInt,PTypeInfo>>.Create();
with regvars do
if Count<>0 then
for i:=0 to Count-1 do
begin
PreDecl:=PreDecl+pointerDecl+Items[i].Key+sLineBreak;
RegVarDict.Add(Items[i].Key,TPair<NativeUInt,PTypeInfo>.Create(base+i*SizeOf(pointer),Items[i].Value));
RegVarDict.Add(Items[i].Key,TPair<NativeUInt,PTypeInfo>.Create(base,Items[i].Value));
inc(base,SizeOf(pointer));
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);
with consts do
if Count<>0 then
for i:=0 to Count-1 do
with Items[i] do
ConstParse(Key,Value,PreDecl,base);
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);
@@ -310,6 +465,7 @@ begin
FreeAndNil(libs);
FreeAndNil(funcs);
FreeAndNil(regvars);
FreeAndNil(consts);
end;
constructor TRTBFasmCompiler.Create(FasmPath:String=FasmPath;AsDll:boolean=false);