From a01fd8c1ea5fb27bbc54dd88799e5ec61011fd8c Mon Sep 17 00:00:00 2001 From: Artem3213212 Date: Sun, 15 Apr 2018 19:22:03 +0300 Subject: [PATCH] Update Fasm Implementation --- Source/RuntimeBuilder.Fasm.pas | 172 +++++++++++++++++++++++++++++++-- Tests/Project2.dproj | 4 +- 2 files changed, 166 insertions(+), 10 deletions(-) diff --git a/Source/RuntimeBuilder.Fasm.pas b/Source/RuntimeBuilder.Fasm.pas index 7ef8716..9246295 100644 --- a/Source/RuntimeBuilder.Fasm.pas +++ b/Source/RuntimeBuilder.Fasm.pas @@ -48,6 +48,7 @@ type libs:TStringList; funcs:TStringList; regvars:TList>; + consts:TList>; 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>.Create; +consts:=TList>.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'' then + consts.Add(TPair.Create(NameSpace+'.'+Name,Val)) +else + consts.Add(TPair.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 or Value.IsType or Value.IsType then + begin + PreDecl:=PreDecl+Key+' db '+#39+Value.AsType+#39+',0'+sLineBreak; + inc(base,length(Value.AsType)); + end + else if Value.IsType then + begin + PreDecl:=PreDecl+Key+' db '+#39+Value.AsType+#39+',0'+sLineBreak; + inc(base,length(Value.AsType)); + end + else if Value.IsType then + begin + PreDecl:=PreDecl+Key+' db '; + p0:=Pointer(PWideChar(Value.AsType)); + for i:={$IFDEF NEXTGEN}0{$ELSE}1{$ENDIF} to length(Value.AsType){$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)*2); + end + else if Value.IsType then + begin + PreDecl:=PreDecl+Key+' db '; + p0:=Pointer(PWideChar(Value.AsType)); + for i:={$IFDEF NEXTGEN}0{$ELSE}1{$ENDIF} to length(Value.AsType){$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)*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 then + PreDecl:=PreDecl+Key+' equ '+FloatToStrF(Value.AsType,ffFixed,1000,1000)+sLineBreak + else if Value.IsType then + PreDecl:=PreDecl+Key+' equ '+FloatToStrF(Value.AsType,ffFixed,1000,1000)+sLineBreak + else if Value.IsType then + PreDecl:=PreDecl+Key+' equ '+FloatToStrF(Value.AsType,ffFixed,1000,1000)+sLineBreak + else if Value.IsType then + PreDecl:=PreDecl+Key+' equ '+FloatToStrF(Value.AsType,ffFixed,1000,1000)+sLineBreak + else if Value.IsType then + PreDecl:=PreDecl+Key+' equ '+FloatToStrF(Value.AsType,ffFixed,1000,1000)+sLineBreak + else if Value.IsType then + PreDecl:=PreDecl+Key+' equ '+FloatToStrF(Value.AsType,ffFixed,1000,1000)+sLineBreak + else if Value.IsType then + PreDecl:=PreDecl+Key+' equ '+FloatToStrF(Value.AsType,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).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>; 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.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>.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.Create(base+i*SizeOf(pointer),Items[i].Value)); + RegVarDict.Add(Items[i].Key,TPair.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); diff --git a/Tests/Project2.dproj b/Tests/Project2.dproj index a4d16ba..81ee71a 100644 --- a/Tests/Project2.dproj +++ b/Tests/Project2.dproj @@ -467,13 +467,13 @@ 1 - + + - False