Update Fasm Implementation

2018-04-15 19:22:03 +03:00
parent b2702114a5
commit a01fd8c1ea
2 changed files with 166 additions and 10 deletions
--- a/Source/RuntimeBuilder.Fasm.pas
+++ b/Source/RuntimeBuilder.Fasm.pas
@@ -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);
--- a/Tests/Project2.dproj
+++ b/Tests/Project2.dproj
@@ -467,13 +467,13 @@
                        <Operation>1</Operation>
                    </Platform>
                </DeployClass>
-                <ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>
+                <ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
                <ProjectRoot Platform="Android" Name="$(PROJECTNAME)"/>
                <ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
                <ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/>
                <ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
+                <ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>
                <ProjectRoot Platform="OSX32" Name="$(PROJECTNAME)"/>
-                <ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
            </Deployment>
            <Platforms>
                <Platform value="OSX32">False</Platform>