Have the compiler generate indirect symbols for RTTI symbols.

symtype.pas, tdef.rtti_mangledname:
  + add new parameter "indirect" which is used to differtiate between the indirect or the direct RTTI symbol name
symdef.pas:
  * tstoreddef.rtti_mangledname: add an additional $INDIRECT suffix if "indirect" is set to True
  * tclassrefdef.rtti_mangledname: pass along the "indirect" parameter accordingly
  * tobjectdef.rtti_mangledname: pass along teh "indirect" parameter or manually add a "$INDIRECT" if necessary
ncgrtti.pas, TRTTIWriter:
  * write_rtti_extrasyms.enumdef_rtti_ord2stringindex & enumdef_rtti_string2ordindex: write also an indirect symbol with _o2s/_s2o as additional suffix after the $INDIRECT
  * write_rtti: write also indirect symbol

git-svn-id: branches/svenbarth/packages@28238 -

compiler/ncgrtti.pas

@@ -1072,6 +1072,7 @@ implementation
 
         var rttilab:Tasmsymbol;
             h,i,o,prev_value:longint;
+            rttilabind : tasmsymbol;
             mode:(lookup,search); {Modify with care, ordinal value of enum is written.}
             r:single;             {Must be real type because of integer overflow risk.}
 
@@ -1112,7 +1113,7 @@ implementation
             in the code that uses it (if alignment is required). }
           with current_asmdata do
             begin
-              rttilab:=defineasmsymbol(Tstoreddef(def).rtti_mangledname(rt)+'_o2s',AB_GLOBAL,AT_DATA);
+              rttilab:=defineasmsymbol(Tstoreddef(def).rtti_mangledname(rt,false)+'_o2s',AB_GLOBAL,AT_DATA);
               maybe_new_object_file(asmlists[al_rtti]);
               new_section(asmlists[al_rtti],sec_rodata,rttilab.name,const_align(sizeof(pint)));
               asmlists[al_rtti].concat(Tai_symbol.create_global(rttilab,0));
@@ -1145,6 +1146,11 @@ implementation
                     end;
                 end;
               asmlists[al_rtti].concat(Tai_symbol_end.create(rttilab));
+              { write the indirect symbol }
+              rttilabind:=current_asmdata.DefineAsmSymbol(tstoreddef(def).rtti_mangledname(rt,true)+'_o2s',AB_GLOBAL,AT_DATA);
+              current_asmdata.asmlists[al_rtti].concat(Tai_symbol.Create_Global(rttilabind,0));
+              current_asmdata.asmlists[al_rtti].concat(Tai_const.Createname(rttilab.name,AT_DATA,0));
+              current_asmdata.asmlists[al_rtti].concat(tai_symbol_end.Create(rttilabind));
             end;
         end;
 
@@ -1154,13 +1160,14 @@ implementation
         procedure enumdef_rtti_string2ordindex(const sym_count:longint; const offsets:plongint; const syms:Penumsym; const st:longint);
 
         var rttilab:Tasmsymbol;
+            rttilabind : tasmsymbol;
             i:longint;
 
         begin
           { write rtti data }
           with current_asmdata do
             begin
-              rttilab:=defineasmsymbol(Tstoreddef(def).rtti_mangledname(rt)+'_s2o',AB_GLOBAL,AT_DATA);
+              rttilab:=defineasmsymbol(Tstoreddef(def).rtti_mangledname(rt,false)+'_s2o',AB_GLOBAL,AT_DATA);
               maybe_new_object_file(asmlists[al_rtti]);
               new_section(asmlists[al_rtti],sec_rodata,rttilab.name,const_align(sizeof(pint)));
               asmlists[al_rtti].concat(Tai_symbol.create_global(rttilab,0));
@@ -1176,6 +1183,11 @@ implementation
                   asmlists[al_rtti].concat(Tai_const.create_sym_offset(mainrtti,st+offsets[i]));
                 end;
               asmlists[al_rtti].concat(Tai_symbol_end.create(rttilab));
+              { write the indirect symbol }
+              rttilabind:=current_asmdata.DefineAsmSymbol(tstoreddef(def).rtti_mangledname(rt,true)+'_s2o',AB_GLOBAL,AT_DATA);
+              current_asmdata.asmlists[al_rtti].concat(Tai_symbol.Create_Global(rttilabind,0));
+              current_asmdata.asmlists[al_rtti].concat(Tai_const.Createname(rttilab.name,AT_DATA,0));
+              current_asmdata.asmlists[al_rtti].concat(tai_symbol_end.Create(rttilabind));
             end;
         end;
 
@@ -1335,7 +1347,8 @@ implementation
 
     procedure TRTTIWriter.write_rtti(def:tdef;rt:trttitype);
       var
-        rttilab : tasmsymbol;
+        rttilab,
+        rttilabind : tasmsymbol;
       begin
         { only write rtti of definitions from the current module }
         if not findunitsymtable(def.owner).iscurrentunit then
@@ -1350,13 +1363,18 @@ implementation
         { write first all dependencies }
         write_child_rtti_data(def,rt);
         { write rtti data }
-        rttilab:=current_asmdata.DefineAsmSymbol(tstoreddef(def).rtti_mangledname(rt),AB_GLOBAL,AT_DATA);
+        rttilab:=current_asmdata.DefineAsmSymbol(tstoreddef(def).rtti_mangledname(rt,false),AB_GLOBAL,AT_DATA);
         maybe_new_object_file(current_asmdata.asmlists[al_rtti]);
         new_section(current_asmdata.asmlists[al_rtti],sec_rodata,rttilab.name,const_align(sizeof(pint)));
         current_asmdata.asmlists[al_rtti].concat(Tai_symbol.Create_global(rttilab,0));
         write_rtti_data(def,rt);
         current_asmdata.asmlists[al_rtti].concat(Tai_symbol_end.Create(rttilab));
         write_rtti_extrasyms(def,rt,rttilab);
+        { write the indirect symbol }
+        rttilabind:=current_asmdata.DefineAsmSymbol(tstoreddef(def).rtti_mangledname(rt,true),AB_GLOBAL,AT_DATA);
+        current_asmdata.asmlists[al_rtti].concat(Tai_symbol.Create_Global(rttilabind,0));
+        current_asmdata.asmlists[al_rtti].concat(Tai_const.Createname(rttilab.name,AT_DATA,0));
+        current_asmdata.asmlists[al_rtti].concat(tai_symbol_end.Create(rttilabind));
       end;
 
 

compiler/symdef.pas

@@ -100,7 +100,7 @@ interface
           function  alignment:shortint;override;
           function  is_publishable : boolean;override;
           function  needs_inittable : boolean;override;
-          function  rtti_mangledname(rt:trttitype):string;override;
+          function  rtti_mangledname(rt:trttitype;indirect:boolean=false):string;override;
           function  OwnerHierarchyName: string; override;
           function  fullownerhierarchyname:string;override;
           function  needs_separate_initrtti:boolean;override;
@@ -418,7 +418,7 @@ interface
           function  is_publishable : boolean;override;
           function  needs_inittable : boolean;override;
           function  needs_separate_initrtti : boolean;override;
-          function  rtti_mangledname(rt:trttitype):string;override;
+          function  rtti_mangledname(rt:trttitype;indirect:boolean=false):string;override;
           function  vmt_mangledname : TSymStr;
           procedure check_forwards; override;
           procedure insertvmt;
@@ -453,7 +453,7 @@ interface
           function getcopy:tstoreddef;override;
           function GetTypeName:string;override;
           function is_publishable : boolean;override;
-          function rtti_mangledname(rt:trttitype):string;override;
+          function rtti_mangledname(rt:trttitype;indirect:boolean=false):string;override;
           procedure register_created_object_type;override;
        end;
        tclassrefdefclass = class of tclassrefdef;
@@ -1755,9 +1755,10 @@ implementation
       end;
 
 
-    function tstoreddef.rtti_mangledname(rt : trttitype) : string;
+    function tstoreddef.rtti_mangledname(rt : trttitype;indirect:boolean) : string;
       var
         prefix : string[4];
+        suffix : string;
       begin
         if (rt=fullrtti) or (not needs_separate_initrtti) then
           begin
@@ -1769,11 +1770,15 @@ implementation
             prefix:='INIT';
             include(defstates,ds_init_table_used);
           end;
+        if indirect then
+          suffix:='$INDIRECT'
+        else
+          suffix:='';
         if assigned(typesym) and
            (owner.symtabletype in [staticsymtable,globalsymtable]) then
-          result:=make_mangledname(prefix,owner,typesym.name)
+          result:=make_mangledname(prefix,owner,typesym.name+suffix)
         else
-          result:=make_mangledname(prefix,findunitsymtable(owner),'DEF'+tostr(DefId))
+          result:=make_mangledname(prefix,findunitsymtable(owner),'DEF'+tostr(DefId)+suffix);
       end;
 
 
@@ -3221,12 +3226,12 @@ implementation
       end;
 
 
-    function tclassrefdef.rtti_mangledname(rt: trttitype): string;
+    function tclassrefdef.rtti_mangledname(rt: trttitype;indirect:boolean=false): string;
       begin
         if (tobjectdef(pointeddef).objecttype<>odt_objcclass) then
-          result:=inherited rtti_mangledname(rt)
+          result:=inherited rtti_mangledname(rt,indirect)
         else
-          result:=tobjectdef(pointeddef).rtti_mangledname(objcmetartti);
+          result:=tobjectdef(pointeddef).rtti_mangledname(objcmetartti,indirect);
       end;
 
 
@@ -6451,10 +6456,10 @@ implementation
         result:=not (objecttype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface]);
       end;
 
-    function tobjectdef.rtti_mangledname(rt: trttitype): string;
+    function tobjectdef.rtti_mangledname(rt: trttitype;indirect:boolean): string;
       begin
         if not(objecttype in [odt_objcclass,odt_objcprotocol]) then
-          result:=inherited rtti_mangledname(rt)
+          result:=inherited rtti_mangledname(rt,indirect)
         else
           begin
             { necessary in case of a dynamic array of nsobject, or
@@ -6462,7 +6467,7 @@ implementation
               init/finalisation }
             if rt=initrtti then
               begin
-                result:=voidpointertype.rtti_mangledname(rt);
+                result:=voidpointertype.rtti_mangledname(rt,indirect);
                 exit;
               end;
 
@@ -6532,6 +6537,8 @@ implementation
                 end;
               end;
             result:=result+objextname^;
+            if indirect then
+              result:=result+'$INDIRECT';
           end;
       end;
 

compiler/symtype.pas

@@ -73,7 +73,7 @@ interface
          function  typesymbolprettyname:string;virtual;
          function  mangledparaname:string;
          function  getmangledparaname:TSymStr;virtual;
-         function  rtti_mangledname(rt:trttitype):string;virtual;abstract;
+         function  rtti_mangledname(rt:trttitype;indirect:boolean=false):string;virtual;abstract;
          function  OwnerHierarchyName: string; virtual; abstract;
          function  fullownerhierarchyname:string;virtual;abstract;
          function  size:asizeint;virtual;abstract;