Browse Source

* always generate RTTI patch from peter

marco 21 years ago
parent
commit
9b3b94883b
3 changed files with 25 additions and 29 deletions
  1. 8 4
      compiler/pdecl.pas
  2. 8 4
      compiler/symdef.pas
  3. 9 21
      compiler/symsym.pas

+ 8 - 4
compiler/pdecl.pas

@@ -526,6 +526,10 @@ implementation
                   tt.def.needs_inittable) then
                   tt.def.needs_inittable) then
                 generate_inittable(newtype);
                 generate_inittable(newtype);
 
 
+              { Always generate RTTI info for all types. This is to have typeinfo() return
+                the same pointer }
+              generate_rtti(newtype);
+
               { for objects we should write the vmt and interfaces.
               { for objects we should write the vmt and interfaces.
                 This need to be done after the rtti has been written, because
                 This need to be done after the rtti has been written, because
                 it can contain a reference to that data (PFV)
                 it can contain a reference to that data (PFV)
@@ -537,9 +541,6 @@ implementation
                  { generate and check virtual methods, must be done
                  { generate and check virtual methods, must be done
                    before RTTI is written }
                    before RTTI is written }
                  ch.genvmt;
                  ch.genvmt;
-                 { generate rtti info if published items are available }
-                 if (oo_can_have_published in tobjectdef(tt.def).objectoptions) then
-                   generate_rtti(newtype);
                  if is_interface(tobjectdef(tt.def)) then
                  if is_interface(tobjectdef(tt.def)) then
                    ch.writeinterfaceids;
                    ch.writeinterfaceids;
                  if (oo_has_vmt in tobjectdef(tt.def).objectoptions) then
                  if (oo_has_vmt in tobjectdef(tt.def).objectoptions) then
@@ -655,7 +656,10 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.73  2003-12-10 16:37:01  peter
+  Revision 1.74  2003-12-12 12:09:40  marco
+   * always generate RTTI patch from peter
+
+  Revision 1.73  2003/12/10 16:37:01  peter
     * global property support for fpc modes
     * global property support for fpc modes
 
 
   Revision 1.72  2003/11/12 15:48:48  peter
   Revision 1.72  2003/11/12 15:48:48  peter

+ 8 - 4
compiler/symdef.pas

@@ -5569,10 +5569,11 @@ implementation
              end;
              end;
            fullrtti :
            fullrtti :
              begin
              begin
-               if objecttype in [odt_interfacecom,odt_interfacecorba] then
-                 rttiList.concat(Tai_const.Create_32bit(0))
+               if (oo_has_vmt in objectoptions) and
+                  not(objecttype in [odt_interfacecom,odt_interfacecorba]) then
+                 rttiList.concat(Tai_const_symbol.Createname(vmt_mangledname))
                else
                else
-                 rttiList.concat(Tai_const_symbol.Createname(vmt_mangledname));
+                 rttiList.concat(Tai_const.Create_32bit(0));
 
 
                { write owner typeinfo }
                { write owner typeinfo }
                if assigned(childof) and (oo_can_have_published in childof.objectoptions) then
                if assigned(childof) and (oo_can_have_published in childof.objectoptions) then
@@ -6117,7 +6118,10 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.191  2003-12-08 22:34:24  peter
+  Revision 1.192  2003-12-12 12:09:40  marco
+   * always generate RTTI patch from peter
+
+  Revision 1.191  2003/12/08 22:34:24  peter
     * tai_const.create_32bit changed to cardinal
     * tai_const.create_32bit changed to cardinal
 
 
   Revision 1.190  2003/11/10 22:02:52  peter
   Revision 1.190  2003/11/10 22:02:52  peter

+ 9 - 21
compiler/symsym.pas

@@ -1511,15 +1511,15 @@ implementation
         ref:=_ref;
         ref:=_ref;
       end;
       end;
 
 
-    
+
     destructor tabsolutesym.destroy;
     destructor tabsolutesym.destroy;
       begin
       begin
         if assigned(ref) then
         if assigned(ref) then
           ref.free;
           ref.free;
-        inherited destroy;  
+        inherited destroy;
       end;
       end;
-      
-      
+
+
     constructor tabsolutesym.ppuload(ppufile:tcompilerppufile);
     constructor tabsolutesym.ppuload(ppufile:tcompilerppufile);
       begin
       begin
          { Note: This needs to load everything of tvarsym.write }
          { Note: This needs to load everything of tvarsym.write }
@@ -1583,9 +1583,6 @@ implementation
 
 
 
 
     procedure tabsolutesym.deref;
     procedure tabsolutesym.deref;
-      var
-        srsym : tsym;
-        srsymtable : tsymtable;
       begin
       begin
          { inheritance of varsym.deref ! }
          { inheritance of varsym.deref ! }
          vartype.resolve;
          vartype.resolve;
@@ -2596,20 +2593,8 @@ implementation
     function trttisym.mangledname : string;
     function trttisym.mangledname : string;
       const
       const
         prefix : array[trttitype] of string[5]=('RTTI_','INIT_');
         prefix : array[trttitype] of string[5]=('RTTI_','INIT_');
-      var
-        s : string;
-        p : tsymtable;
       begin
       begin
-        s:='';
-        p:=owner;
-        while assigned(p) and (p.symtabletype=localsymtable) do
-         begin
-           s:=s+'_'+p.defowner.name;
-           p:=p.defowner.owner;
-         end;
-        if not(p.symtabletype in [globalsymtable,staticsymtable]) then
-         internalerror(200108265);
-        mangledname:=prefix[rttityp]+p.name^+s+'$_'+Copy(name,5,255);
+        result:=make_mangledname(prefix[rttityp],owner,Copy(name,5,255));
       end;
       end;
 
 
 
 
@@ -2699,7 +2684,10 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.137  2003-12-01 18:44:15  peter
+  Revision 1.138  2003-12-12 12:09:40  marco
+   * always generate RTTI patch from peter
+
+  Revision 1.137  2003/12/01 18:44:15  peter
     * fixed some crashes
     * fixed some crashes
     * fixed varargs and register calling probs
     * fixed varargs and register calling probs