Просмотр исходного кода

* changed tcallnode.fforcedprocname from shortstring into tsymstr,
so it doesn't truncate mangled names for the JVM target (it's
used there since r27149)
o adapted a number of WPO helpers to use tsymstr instead of
shortstring, but the WPO devirtualization functionality is
still limited to shortstrings internally

git-svn-id: trunk@27741 -

Jonas Maebe 11 лет назад
Родитель
Сommit
5fa09fa2f4
7 измененных файлов с 39 добавлено и 22 удалено
  1. 1 1
      compiler/jvm/njvmcal.pas
  2. 14 0
      compiler/ncal.pas
  3. 8 4
      compiler/ncgcal.pas
  4. 1 1
      compiler/ncgvmt.pas
  5. 6 6
      compiler/optvirt.pas
  6. 4 4
      compiler/wpobase.pas
  7. 5 6
      compiler/wpoinfo.pas

+ 1 - 1
compiler/jvm/njvmcal.pas

@@ -593,7 +593,7 @@ implementation
           { set fforcedprocname so that even virtual method calls will be
           { set fforcedprocname so that even virtual method calls will be
             name-based (instead of based on VMT entry numbers) }
             name-based (instead of based on VMT entry numbers) }
           if procdefinition.typ=procdef then
           if procdefinition.typ=procdef then
-            fforcedprocname:=stringdup(tprocdef(procdefinition).mangledname)
+            fforcedprocname:=tprocdef(procdefinition).mangledname
         end;
         end;
     end;
     end;
 
 

+ 14 - 0
compiler/ncal.pas

@@ -102,7 +102,11 @@ interface
             to ppu, is set while processing the node). Also used on the JVM
             to ppu, is set while processing the node). Also used on the JVM
             target for calling virtual methods, as this is name-based and not
             target for calling virtual methods, as this is name-based and not
             based on VMT entry locations }
             based on VMT entry locations }
+{$ifdef symansistr}
+          fforcedprocname: TSymStr;
+{$else symansistr}
           fforcedprocname: pshortstring;
           fforcedprocname: pshortstring;
+{$endif symansistr}
        public
        public
           { the symbol containing the definition of the procedure }
           { the symbol containing the definition of the procedure }
           { to call                                               }
           { to call                                               }
@@ -1206,7 +1210,9 @@ implementation
          funcretnode.free;
          funcretnode.free;
          if assigned(varargsparas) then
          if assigned(varargsparas) then
            varargsparas.free;
            varargsparas.free;
+{$ifndef symansistr}
          stringdispose(fforcedprocname);
          stringdispose(fforcedprocname);
+{$endif symansistr}
          inherited destroy;
          inherited destroy;
       end;
       end;
 
 
@@ -1359,10 +1365,14 @@ implementation
          end
          end
         else
         else
          n.varargsparas:=nil;
          n.varargsparas:=nil;
+{$ifdef symansistr}
+        n.fforcedprocname:=fforcedprocname;
+{$else symansistr}
         if assigned(fforcedprocname) then
         if assigned(fforcedprocname) then
           n.fforcedprocname:=stringdup(fforcedprocname^)
           n.fforcedprocname:=stringdup(fforcedprocname^)
         else
         else
           n.fforcedprocname:=nil;
           n.fforcedprocname:=nil;
+{$endif symansistr}
         result:=n;
         result:=n;
       end;
       end;
 
 
@@ -2074,7 +2084,11 @@ implementation
            (srsym.typ<>procsym) or
            (srsym.typ<>procsym) or
            (tprocsym(srsym).ProcdefList.count<>1) then
            (tprocsym(srsym).ProcdefList.count<>1) then
           Message1(cg_f_unknown_compilerproc,'objc.'+msgsendname);
           Message1(cg_f_unknown_compilerproc,'objc.'+msgsendname);
+{$ifdef symansistr}
+        fforcedprocname:=tprocdef(tprocsym(srsym).ProcdefList[0]).mangledname;
+{$else symansistr}
         fforcedprocname:=stringdup(tprocdef(tprocsym(srsym).ProcdefList[0]).mangledname);
         fforcedprocname:=stringdup(tprocdef(tprocsym(srsym).ProcdefList[0]).mangledname);
+{$endif symansistr}
 
 
         { B) Handle self }
         { B) Handle self }
         { 1) in case of sending a message to a superclass, self is a pointer to
         { 1) in case of sending a message to a superclass, self is a pointer to

+ 8 - 4
compiler/ncgcal.pas

@@ -768,7 +768,7 @@ implementation
 
 
     procedure tcgcallnode.pass_generate_code;
     procedure tcgcallnode.pass_generate_code;
       var
       var
-        name_to_call: shortstring;
+        name_to_call: TSymStr;
         regs_to_save_int,
         regs_to_save_int,
         regs_to_save_address,
         regs_to_save_address,
         regs_to_save_fpu,
         regs_to_save_fpu,
@@ -868,9 +868,13 @@ implementation
                end;
                end;
 {$endif vtentry}
 {$endif vtentry}
 
 
-             name_to_call:='';
-             if assigned(fforcedprocname) then
-               name_to_call:=fforcedprocname^;
+{$ifdef symansistr}
+              name_to_call:=fforcedprocname;
+{$else symansistr}
+              name_to_call:='';
+              if assigned(fforcedprocname) then
+                name_to_call:=fforcedprocname^;
+{$endif symansistr}
              { When methodpointer is typen we don't need (and can't) load
              { When methodpointer is typen we don't need (and can't) load
                a pointer. We can directly call the correct procdef (PFV) }
                a pointer. We can directly call the correct procdef (PFV) }
              if (name_to_call='') and
              if (name_to_call='') and

+ 1 - 1
compiler/ncgvmt.pas

@@ -763,7 +763,7 @@ implementation
          vmtpd : tprocdef;
          vmtpd : tprocdef;
          vmtentry : pvmtentry;
          vmtentry : pvmtentry;
          i  : longint;
          i  : longint;
-         procname : string;
+         procname : TSymStr;
 {$ifdef vtentry}
 {$ifdef vtentry}
          hs : string;
          hs : string;
 {$endif vtentry}
 {$endif vtentry}

+ 6 - 6
compiler/optvirt.pas

@@ -140,7 +140,7 @@ unit optvirt;
         procedure converttreenode(node: tinheritancetreenode; arg: pointer);
         procedure converttreenode(node: tinheritancetreenode; arg: pointer);
         function addunitifnew(const n: shortstring): tunitdevirtinfo;
         function addunitifnew(const n: shortstring): tunitdevirtinfo;
         function findunit(const n: shortstring): tunitdevirtinfo;
         function findunit(const n: shortstring): tunitdevirtinfo;
-        function getstaticname(forvmtentry: boolean; objdef, procdef: tdef; out staticname: string): boolean;
+        function getstaticname(forvmtentry: boolean; objdef, procdef: tdef; out staticname: TSymStr): boolean;
         procedure documentformat(writer: twposectionwriterintf);
         procedure documentformat(writer: twposectionwriterintf);
        public
        public
         constructor create; override;
         constructor create; override;
@@ -157,8 +157,8 @@ unit optvirt;
 
 
         { information providing }
         { information providing }
         procedure loadfromwpofilesection(reader: twposectionreaderintf); override;
         procedure loadfromwpofilesection(reader: twposectionreaderintf); override;
-        function staticnameforcallingvirtualmethod(objdef, procdef: tdef; out staticname: string): boolean; override;
-        function staticnameforvmtentry(objdef, procdef: tdef; out staticname: string): boolean; override;
+        function staticnameforcallingvirtualmethod(objdef, procdef: tdef; out staticname: TSymStr): boolean; override;
+        function staticnameforvmtentry(objdef, procdef: tdef; out staticname: TSymStr): boolean; override;
 
 
       end;
       end;
 
 
@@ -1086,7 +1086,7 @@ unit optvirt;
       end;
       end;
 
 
 
 
-    function tprogdevirtinfo.getstaticname(forvmtentry: boolean; objdef, procdef: tdef; out staticname: string): boolean;
+    function tprogdevirtinfo.getstaticname(forvmtentry: boolean; objdef, procdef: tdef; out staticname: TSymStr): boolean;
       var
       var
         unitid,
         unitid,
         classid,
         classid,
@@ -1176,13 +1176,13 @@ unit optvirt;
 
 
 
 
 
 
-    function tprogdevirtinfo.staticnameforcallingvirtualmethod(objdef, procdef: tdef; out staticname: string): boolean;
+    function tprogdevirtinfo.staticnameforcallingvirtualmethod(objdef, procdef: tdef; out staticname: TSymStr): boolean;
       begin
       begin
         result:=getstaticname(false,objdef,procdef,staticname);
         result:=getstaticname(false,objdef,procdef,staticname);
       end;
       end;
 
 
 
 
-    function tprogdevirtinfo.staticnameforvmtentry(objdef, procdef: tdef; out staticname: string): boolean;
+    function tprogdevirtinfo.staticnameforvmtentry(objdef, procdef: tdef; out staticname: TSymStr): boolean;
       begin
       begin
         result:=getstaticname(true,objdef,procdef,staticname);
         result:=getstaticname(true,objdef,procdef,staticname);
       end;
       end;

+ 4 - 4
compiler/wpobase.pas

@@ -254,12 +254,12 @@ type
       a static call when it's called as objdef.procdef, and if so returns the
       a static call when it's called as objdef.procdef, and if so returns the
       mangled name in staticname.
       mangled name in staticname.
     }
     }
-    function staticnameforcallingvirtualmethod(objdef, procdef: tdef; out staticname: string): boolean; virtual; abstract;
+    function staticnameforcallingvirtualmethod(objdef, procdef: tdef; out staticname: TSymStr): boolean; virtual; abstract;
     { checks whether procdef (a procdef for a virtual method) can be replaced with
     { checks whether procdef (a procdef for a virtual method) can be replaced with
       a different procname in the vmt of objdef, and if so returns the new
       a different procname in the vmt of objdef, and if so returns the new
       mangledname in staticname
       mangledname in staticname
     }
     }
-    function staticnameforvmtentry(objdef, procdef: tdef; out staticname: string): boolean; virtual; abstract;
+    function staticnameforvmtentry(objdef, procdef: tdef; out staticname: TSymStr): boolean; virtual; abstract;
   end;
   end;
 
 
   twpodeadcodehandler = class(twpocomponentbase)
   twpodeadcodehandler = class(twpocomponentbase)
@@ -325,9 +325,9 @@ type
 
 
     { routines accessing the optimizer information }
     { routines accessing the optimizer information }
     { 1) devirtualization at the symbol name level }
     { 1) devirtualization at the symbol name level }
-    function can_be_devirtualized(objdef, procdef: tdef; out name: shortstring): boolean; virtual; abstract;
+    function can_be_devirtualized(objdef, procdef: tdef; out name: TSymStr): boolean; virtual; abstract;
     { 2) optimal replacement method name in vmt }
     { 2) optimal replacement method name in vmt }
-    function optimized_name_for_vmt(objdef, procdef: tdef; out name: shortstring): boolean; virtual; abstract;
+    function optimized_name_for_vmt(objdef, procdef: tdef; out name: TSymStr): boolean; virtual; abstract;
     { 3) does a symbol appear in the final binary (i.e., not removed by dead code stripping/smart linking).
     { 3) does a symbol appear in the final binary (i.e., not removed by dead code stripping/smart linking).
         WARNING: do *not* call for inline functions/procedures/methods/...
         WARNING: do *not* call for inline functions/procedures/methods/...
     }
     }

+ 5 - 6
compiler/wpoinfo.pas

@@ -26,7 +26,7 @@ unit wpoinfo;
 interface
 interface
 
 
 uses
 uses
-  cclasses,
+  globtype,cclasses,
   symtype,
   symtype,
   wpobase,
   wpobase,
   ppu;
   ppu;
@@ -62,8 +62,8 @@ type
   { twpoinfomanager }
   { twpoinfomanager }
 
 
   twpoinfomanager = class(twpoinfomanagerbase)
   twpoinfomanager = class(twpoinfomanagerbase)
-    function can_be_devirtualized(objdef, procdef: tdef; out name: shortstring): boolean; override;
-    function optimized_name_for_vmt(objdef, procdef: tdef; out name: shortstring): boolean; override;
+    function can_be_devirtualized(objdef, procdef: tdef; out name: TSymStr): boolean; override;
+    function optimized_name_for_vmt(objdef, procdef: tdef; out name: TSymStr): boolean; override;
     function symbol_live(const name: shortstring): boolean; override;
     function symbol_live(const name: shortstring): boolean; override;
   end;
   end;
 
 
@@ -71,7 +71,6 @@ type
 implementation
 implementation
 
 
   uses
   uses
-    globtype,
     globals,
     globals,
     symdef,
     symdef,
     verbose;
     verbose;
@@ -287,7 +286,7 @@ implementation
 
 
   { devirtualisation }
   { devirtualisation }
 
 
-  function twpoinfomanager.can_be_devirtualized(objdef, procdef: tdef; out name: shortstring): boolean;
+  function twpoinfomanager.can_be_devirtualized(objdef, procdef: tdef; out name: TSymStr): boolean;
     begin
     begin
       if not assigned(wpoinfouse[wpo_devirtualization_context_insensitive]) or
       if not assigned(wpoinfouse[wpo_devirtualization_context_insensitive]) or
          not(cs_wpo_devirtualize_calls in current_settings.dowpoptimizerswitches) then
          not(cs_wpo_devirtualize_calls in current_settings.dowpoptimizerswitches) then
@@ -299,7 +298,7 @@ implementation
     end;
     end;
 
 
 
 
-  function twpoinfomanager.optimized_name_for_vmt(objdef, procdef: tdef; out name: shortstring): boolean;
+  function twpoinfomanager.optimized_name_for_vmt(objdef, procdef: tdef; out name: TSymStr): boolean;
     begin
     begin
       if not assigned(wpoinfouse[wpo_devirtualization_context_insensitive]) or
       if not assigned(wpoinfouse[wpo_devirtualization_context_insensitive]) or
          not(cs_wpo_optimize_vmts in current_settings.dowpoptimizerswitches) then
          not(cs_wpo_optimize_vmts in current_settings.dowpoptimizerswitches) then