* moved rtti to ncgrtti

git-svn-id: trunk@5219 -

.gitattributes

@@ -253,6 +253,7 @@ compiler/ncgld.pas svneol=native#text/plain
 compiler/ncgmat.pas svneol=native#text/plain
 compiler/ncgmem.pas svneol=native#text/plain
 compiler/ncgopt.pas svneol=native#text/plain
+compiler/ncgrtti.pas svneol=native#text/plain
 compiler/ncgset.pas svneol=native#text/plain
 compiler/ncgutil.pas svneol=native#text/plain
 compiler/ncnv.pas svneol=native#text/plain

compiler/cgobj.pas

@@ -552,7 +552,8 @@ implementation
     uses
        globals,options,systems,
        verbose,defutil,paramgr,symsym,
-       tgobj,cutils,procinfo;
+       tgobj,cutils,procinfo,
+       ncgrtti;
 
 
 {*****************************************************************************
@@ -2523,7 +2524,7 @@ implementation
           end
          else
           begin
-            reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
+            reference_reset_symbol(href,RTTIWriter.get_rtti_label(t,initrtti),0);
             paramanager.allocparaloc(list,cgpara2);
             a_paramaddr_ref(list,href,cgpara2);
             paramanager.allocparaloc(list,cgpara1);
@@ -2570,7 +2571,7 @@ implementation
           begin
             if needrtti then
              begin
-               reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
+               reference_reset_symbol(href,RTTIWriter.get_rtti_label(t,initrtti),0);
                tempreg2:=getaddressregister(list);
                a_loadaddr_ref_reg(list,href,tempreg2);
              end;
@@ -2591,7 +2592,7 @@ implementation
           end
          else
           begin
-            reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
+            reference_reset_symbol(href,RTTIWriter.get_rtti_label(t,initrtti),0);
             paramanager.allocparaloc(list,cgpara2);
             a_paramaddr_ref(list,href,cgpara2);
             paramanager.allocparaloc(list,cgpara1);
@@ -2623,7 +2624,7 @@ implementation
            a_load_const_ref(list,OS_ADDR,0,ref)
          else
            begin
-              reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
+              reference_reset_symbol(href,RTTIWriter.get_rtti_label(t,initrtti),0);
               paramanager.allocparaloc(list,cgpara2);
               a_paramaddr_ref(list,href,cgpara2);
               paramanager.allocparaloc(list,cgpara1);
@@ -2657,7 +2658,7 @@ implementation
             end
          else
            begin
-              reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
+              reference_reset_symbol(href,RTTIWriter.get_rtti_label(t,initrtti),0);
               paramanager.allocparaloc(list,cgpara2);
               a_paramaddr_ref(list,href,cgpara2);
               paramanager.allocparaloc(list,cgpara1);

compiler/dbgdwarf.pas

@@ -1895,9 +1895,6 @@ implementation
           enumsym :
             { ignore enum syms, they are written by the owner }
             ;
-          rttisym :
-            { ignore rtti syms, they are only of internal use }
-            ;
           syssym :
             { ignore sys syms, they are only of internal use }
             ;

compiler/ncginl.pas

@@ -62,7 +62,7 @@ implementation
       aasmbase,aasmtai,aasmdata,aasmcpu,parabase,
       cgbase,pass_1,pass_2,
       cpuinfo,cpubase,paramgr,procinfo,
-      nbas,ncon,ncal,ncnv,nld,
+      nbas,ncon,ncal,ncnv,nld,ncgrtti,
       tgobj,ncgutil,
       cgutils,cgobj
 {$ifndef cpu64bit}
@@ -479,7 +479,7 @@ implementation
         begin
           location_reset(location,LOC_REGISTER,OS_ADDR);
           location.register:=cg.getaddressregister(current_asmdata.CurrAsmList);
-          reference_reset_symbol(href,tstoreddef(left.resultdef).get_rtti_label(fullrtti),0);
+          reference_reset_symbol(href,RTTIWriter.get_rtti_label(left.resultdef,fullrtti),0);
           cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,href,location.register);
         end;
 

compiler/ncgld.pas

@@ -55,7 +55,7 @@ implementation
       systems,
       verbose,globtype,globals,
       symconst,symtype,symdef,symsym,defutil,paramgr,
-      ncnv,ncon,nmem,nbas,
+      ncnv,ncon,nmem,nbas,ncgrtti,
       aasmbase,aasmtai,aasmdata,aasmcpu,
       cgbase,pass_2,
       procinfo,
@@ -979,7 +979,7 @@ implementation
     procedure tcgrttinode.pass_generate_code;
       begin
         location_reset(location,LOC_CREFERENCE,OS_NO);
-        location.reference.symbol:=rttidef.get_rtti_label(rttitype);
+        location.reference.symbol:=RTTIWriter.get_rtti_label(rttidef,rttitype);
       end;
 
 

compiler/ncgrtti.pas

@@ -0,0 +1,880 @@
+{
+    Copyright (c) 1998-2002 by Florian Klaempfl
+
+    Routines for the code generation of RTTI data structures
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit ncgrtti;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      cclasses,
+      aasmbase,
+      symbase,symconst,symtype,symdef;
+      
+    type
+
+      { TRTTIWriter }
+
+      TRTTIWriter=class
+      private
+        function  fields_count(st:tsymtable;rt:trttitype):longint;
+        procedure fields_write_rtti(st:tsymtable;rt:trttitype);
+        procedure fields_write_rtti_data(st:tsymtable;rt:trttitype);
+        procedure published_write_rtti(st:tsymtable;rt:trttitype);
+        function  published_properties_count(st:tsymtable):longint;
+        procedure published_properties_write_rtti_data(propnamelist:TFPHashObjectList;st:tsymtable);
+        procedure collect_propnamelist(propnamelist:TFPHashObjectList;objdef:tobjectdef);
+        procedure write_rtti_name(def:tdef);
+        procedure write_rtti_data(def:tdef;rt:trttitype);
+        procedure write_child_rtti_data(def:tdef;rt:trttitype);
+        function  ref_rtti(def:tdef;rt:trttitype):tasmsymbol;
+      public
+        procedure write_rtti(def:tdef;rt:trttitype);
+        function  get_rtti_label(def:tdef;rt:trttitype):tasmsymbol;
+      end;
+
+    var
+      RTTIWriter : TRTTIWriter;
+      
+      
+implementation
+
+    uses
+       cutils,
+       globals,globtype,verbose,
+       fmodule,
+       symsym,
+       aasmtai,aasmdata
+       ;
+
+
+    const
+       rttidefopt : array[trttitype] of tdefoption = (df_has_rttitable,df_has_inittable);
+       
+    type
+       TPropNameListItem = class(TFPHashObject)
+         propindex : longint;
+         propowner : TSymtable;
+       end;
+
+
+{***************************************************************************
+                              TRTTIWriter
+***************************************************************************}
+
+    procedure TRTTIWriter.write_rtti_name(def:tdef);
+      var
+         hs : string;
+      begin
+         { name }
+         if assigned(def.typesym) then
+           begin
+              hs:=ttypesym(def.typesym).realname;
+              current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(chr(length(hs))+hs));
+           end
+         else
+           current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(#0));
+      end;
+
+
+    function TRTTIWriter.fields_count(st:tsymtable;rt:trttitype):longint;
+      var
+        i   : longint;
+        sym : tsym;
+      begin
+        result:=0;
+        for i:=0 to st.SymList.Count-1 do
+          begin
+            sym:=tsym(st.SymList[i]);
+            if (rt=fullrtti) or
+               (
+                (tsym(sym).typ=fieldvarsym) and
+                tfieldvarsym(sym).vardef.needs_inittable
+               ) then
+              inc(result);
+          end;
+      end;
+
+
+    procedure TRTTIWriter.fields_write_rtti_data(st:tsymtable;rt:trttitype);
+      var
+        i   : longint;
+        sym : tsym;
+      begin
+        for i:=0 to st.SymList.Count-1 do
+          begin
+            sym:=tsym(st.SymList[i]);
+            if (rt=fullrtti) or
+               (
+                (tsym(sym).typ=fieldvarsym) and
+                tfieldvarsym(sym).vardef.needs_inittable
+               ) then
+              begin
+                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(tfieldvarsym(sym).vardef,rt)));
+                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(tfieldvarsym(sym).fieldoffset));
+              end;
+          end;
+      end;
+
+
+    procedure TRTTIWriter.fields_write_rtti(st:tsymtable;rt:trttitype);
+      var
+        i   : longint;
+        sym : tsym;
+      begin
+        for i:=0 to st.SymList.Count-1 do
+          begin
+            sym:=tsym(st.SymList[i]);
+            if (rt=fullrtti) or
+               (
+                (tsym(sym).typ=fieldvarsym) and
+                tfieldvarsym(sym).vardef.needs_inittable
+               ) then
+              write_rtti(tfieldvarsym(sym).vardef,rt);
+          end;
+      end;
+
+
+    procedure TRTTIWriter.published_write_rtti(st:tsymtable;rt:trttitype);
+      var
+        i   : longint;
+        sym : tsym;
+      begin
+        for i:=0 to st.SymList.Count-1 do
+          begin
+            sym:=tsym(st.SymList[i]);
+            if (sp_published in tsym(sym).symoptions) then
+              begin
+                case tsym(sym).typ of
+                  propertysym:
+                    write_rtti(tpropertysym(sym).propdef,rt);
+                  fieldvarsym:
+                    write_rtti(tfieldvarsym(sym).vardef,rt);
+                end;
+              end;
+          end;
+      end;
+
+
+    function TRTTIWriter.published_properties_count(st:tsymtable):longint;
+      var
+        i   : longint;
+        sym : tsym;
+      begin
+        result:=0;
+        for i:=0 to st.SymList.Count-1 do
+          begin
+            sym:=tsym(st.SymList[i]);
+            if (tsym(sym).typ=propertysym) and
+               (sp_published in tsym(sym).symoptions) then
+              inc(result);
+          end;
+      end;
+
+
+    procedure TRTTIWriter.collect_propnamelist(propnamelist:TFPHashObjectList;objdef:tobjectdef);
+      var
+        i   : longint;
+        sym : tsym;
+        pn  : tpropnamelistitem;
+      begin
+        if assigned(objdef.childof) then
+          collect_propnamelist(propnamelist,objdef.childof);
+        for i:=0 to objdef.symtable.SymList.Count-1 do
+          begin
+            sym:=tsym(objdef.symtable.SymList[i]);
+            if (tsym(sym).typ=propertysym) and
+               (sp_published in tsym(sym).symoptions) then
+              begin
+                pn:=TPropNameListItem(propnamelist.Find(tsym(sym).name));
+                if not assigned(pn) then
+                  begin
+                     pn:=tpropnamelistitem.create(propnamelist,tsym(sym).name);
+                     pn.propindex:=propnamelist.count-1;
+                     pn.propowner:=tsym(sym).owner;
+                  end;
+             end;
+          end;
+      end;
+
+
+    procedure TRTTIWriter.published_properties_write_rtti_data(propnamelist:TFPHashObjectList;st:tsymtable);
+      var
+        i : longint;
+        sym : tsym;
+        proctypesinfo : byte;
+        propnameitem  : tpropnamelistitem;
+
+        procedure writeaccessproc(pap:tpropaccesslisttypes; shiftvalue : byte; unsetvalue: byte);
+        var
+           typvalue : byte;
+           hp : ppropaccesslistitem;
+           address : longint;
+           def : tdef;
+           hpropsym : tpropertysym;
+           propaccesslist : tpropaccesslist;
+        begin
+           hpropsym:=tpropertysym(sym);
+           repeat
+             propaccesslist:=hpropsym.propaccesslist[pap];
+             if not propaccesslist.empty then
+               break;
+             hpropsym:=hpropsym.overridenpropsym;
+           until not assigned(hpropsym);
+           if not(assigned(propaccesslist) and assigned(propaccesslist.firstsym))  then
+             begin
+                current_asmdata.asmlists[al_rtti].concat(Tai_const.create(aitconst_ptr,unsetvalue));
+                typvalue:=3;
+             end
+           else if propaccesslist.firstsym^.sym.typ=fieldvarsym then
+             begin
+                address:=0;
+                hp:=propaccesslist.firstsym;
+                def:=nil;
+                while assigned(hp) do
+                  begin
+                     case hp^.sltype of
+                       sl_load :
+                         begin
+                           def:=tfieldvarsym(hp^.sym).vardef;
+                           inc(address,tfieldvarsym(hp^.sym).fieldoffset);
+                         end;
+                       sl_subscript :
+                         begin
+                           if not(assigned(def) and (def.typ=recorddef)) then
+                             internalerror(200402171);
+                           inc(address,tfieldvarsym(hp^.sym).fieldoffset);
+                           def:=tfieldvarsym(hp^.sym).vardef;
+                         end;
+                       sl_vec :
+                         begin
+                           if not(assigned(def) and (def.typ=arraydef)) then
+                             internalerror(200402172);
+                           def:=tarraydef(def).elementdef;
+                           inc(address,def.size*hp^.value);
+                         end;
+                     end;
+                     hp:=hp^.next;
+                  end;
+                current_asmdata.asmlists[al_rtti].concat(Tai_const.create(aitconst_ptr,address));
+                typvalue:=0;
+             end
+           else
+             begin
+                { When there was an error then procdef is not assigned }
+                if not assigned(propaccesslist.procdef) then
+                  exit;
+                if not(po_virtualmethod in tprocdef(propaccesslist.procdef).procoptions) then
+                  begin
+                     current_asmdata.asmlists[al_rtti].concat(Tai_const.createname(tprocdef(propaccesslist.procdef).mangledname,0));
+                     typvalue:=1;
+                  end
+                else
+                  begin
+                     { virtual method, write vmt offset }
+                     current_asmdata.asmlists[al_rtti].concat(Tai_const.create(aitconst_ptr,
+                       tprocdef(propaccesslist.procdef)._class.vmtmethodoffset(tprocdef(propaccesslist.procdef).extnumber)));
+                     typvalue:=2;
+                  end;
+             end;
+           proctypesinfo:=proctypesinfo or (typvalue shl shiftvalue);
+        end;
+
+      begin
+        for i:=0 to st.SymList.Count-1 do
+          begin
+            sym:=tsym(st.SymList[i]);
+            if (sym.typ=propertysym) and
+               (sp_published in sym.symoptions) then
+              begin
+                if ppo_indexed in tpropertysym(sym).propoptions then
+                  proctypesinfo:=$40
+                else
+                  proctypesinfo:=0;
+                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(tpropertysym(sym).propdef,fullrtti)));
+                writeaccessproc(palt_read,0,0);
+                writeaccessproc(palt_write,2,0);
+                { is it stored ? }
+                if not(ppo_stored in tpropertysym(sym).propoptions) then
+                  begin
+                    { no, so put a constant zero }
+                    current_asmdata.asmlists[al_rtti].concat(Tai_const.create(aitconst_ptr,0));
+                    proctypesinfo:=proctypesinfo or (3 shl 4);
+                  end
+                else
+                  writeaccessproc(palt_stored,4,1); { maybe; if no procedure put a constant 1 (=true) }
+                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(tpropertysym(sym).index));
+                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(tpropertysym(sym).default));
+                propnameitem:=TPropNameListItem(propnamelist.Find(tpropertysym(sym).name));
+                if not assigned(propnameitem) then
+                  internalerror(200512201);
+                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(propnameitem.propindex));
+                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(proctypesinfo));
+                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(tpropertysym(sym).realname)));
+                current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(tpropertysym(sym).realname));
+{$ifdef cpurequiresproperalignment}
+                current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
+{$endif cpurequiresproperalignment}
+             end;
+          end;
+      end;
+
+
+    procedure TRTTIWriter.write_rtti_data(def:tdef;rt:trttitype);
+
+        procedure unknown_rtti(def:tstoreddef);
+        begin
+          current_asmdata.asmlists[al_rtti].concat(tai_const.create_8bit(tkUnknown));
+          write_rtti_name(def);
+        end;
+
+        procedure variantdef_rtti(def:tvariantdef);
+        begin
+           current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkVariant));
+        end;
+
+        procedure stringdef_rtti(def:tstringdef);
+        begin
+          case def.stringtype of
+            st_ansistring:
+              begin
+                 current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkAString));
+                 write_rtti_name(def);
+              end;
+            st_widestring:
+              begin
+                 current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkWString));
+                 write_rtti_name(def);
+              end;
+            st_longstring:
+              begin
+                 current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkLString));
+                 write_rtti_name(def);
+              end;
+            st_shortstring:
+              begin
+                 current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkSString));
+                 write_rtti_name(def);
+                 current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(def.len));
+{$ifdef cpurequiresproperalignment}
+                 current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
+{$endif cpurequiresproperalignment}
+              end;
+          end;
+        end;
+
+        procedure enumdef_rtti(def:tenumdef);
+        var
+           hp : tenumsym;
+        begin
+          current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkEnumeration));
+          write_rtti_name(def);
+{$ifdef cpurequiresproperalignment}
+          current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
+{$endif cpurequiresproperalignment}
+          case longint(def.size) of
+            1 :
+              current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otUByte));
+            2 :
+              current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otUWord));
+            4 :
+              current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otULong));
+          end;
+{$ifdef cpurequiresproperalignment}
+          current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
+{$endif cpurequiresproperalignment}
+          current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(def.min));
+          current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(def.max));
+          if assigned(def.basedef) then
+            current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.basedef,rt)))
+          else
+            current_asmdata.asmlists[al_rtti].concat(Tai_const.create_sym(nil));
+          hp:=tenumsym(def.firstenum);
+          while assigned(hp) do
+            begin
+              current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(hp.realname)));
+              current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(hp.realname));
+              hp:=hp.nextenum;
+            end;
+          current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(0));
+        end;
+
+        procedure orddef_rtti(def:torddef);
+
+          procedure dointeger;
+          const
+            trans : array[tordtype] of byte =
+              (otUByte{otNone},
+               otUByte,otUWord,otULong,otUByte{otNone},
+               otSByte,otSWord,otSLong,otUByte{otNone},
+               otUByte,otUWord,otULong,otUByte,
+               otUByte,otUWord,otUByte);
+          begin
+            write_rtti_name(def);
+{$ifdef cpurequiresproperalignment}
+            current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
+{$endif cpurequiresproperalignment}
+            current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(byte(trans[def.ordtype])));
+{$ifdef cpurequiresproperalignment}
+           current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
+{$endif cpurequiresproperalignment}
+            current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(longint(def.low)));
+            current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(longint(def.high)));
+          end;
+
+        begin
+          case def.ordtype of
+            s64bit :
+              begin
+                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkInt64));
+                write_rtti_name(def);
+{$ifdef cpurequiresproperalignment}
+                current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
+{$endif cpurequiresproperalignment}
+                { low }
+                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_64bit(int64($80000000) shl 32));
+                { high }
+                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_64bit((int64($7fffffff) shl 32) or int64($ffffffff)));
+              end;
+            u64bit :
+              begin
+                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkQWord));
+                write_rtti_name(def);
+{$ifdef cpurequiresproperalignment}
+                current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
+{$endif cpurequiresproperalignment}
+                { low }
+                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_64bit(0));
+                { high }
+                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_64bit(int64((int64($ffffffff) shl 32) or int64($ffffffff))));
+              end;
+            bool8bit:
+              begin
+                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkBool));
+                dointeger;
+              end;
+            uchar:
+              begin
+                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkChar));
+                dointeger;
+              end;
+            uwidechar:
+              begin
+                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkWChar));
+                dointeger;
+              end;
+            else
+              begin
+                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkInteger));
+                dointeger;
+              end;
+          end;
+        end;
+
+
+        procedure floatdef_rtti(def:tfloatdef);
+        const
+          {tfloattype = (s32real,s64real,s80real,s64bit,s128bit);}
+          translate : array[tfloattype] of byte =
+             (ftSingle,ftDouble,ftExtended,ftComp,ftCurr,ftFloat128);
+        begin
+           current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkFloat));
+           write_rtti_name(def);
+{$ifdef cpurequiresproperalignment}
+           current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
+{$endif cpurequiresproperalignment}
+           current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(translate[def.floattype]));
+        end;
+
+
+        procedure setdef_rtti(def:tsetdef);
+        begin
+           current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkSet));
+           write_rtti_name(def);
+{$ifdef cpurequiresproperalignment}
+           current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
+{$endif cpurequiresproperalignment}
+           current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otULong));
+{$ifdef cpurequiresproperalignment}
+           current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
+{$endif cpurequiresproperalignment}
+           current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.elementdef,rt)));
+        end;
+
+
+        procedure arraydef_rtti(def:tarraydef);
+        begin
+           if ado_IsDynamicArray in def.arrayoptions then
+             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkdynarray))
+           else
+             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkarray));
+           write_rtti_name(def);
+{$ifdef cpurequiresproperalignment}
+           current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
+{$endif cpurequiresproperalignment}
+           { size of elements }
+           current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_aint(def.elesize));
+           if not(ado_IsDynamicArray in def.arrayoptions) then
+             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_aint(def.elecount));
+           { element type }
+           current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.elementdef,rt)));
+           { variant type }
+           current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(tstoreddef(def.elementdef).getvardef));
+        end;
+
+        procedure recorddef_rtti(def:trecorddef);
+        var
+          fieldcnt : longint;
+        begin
+           current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkrecord));
+           write_rtti_name(def);
+{$ifdef cpurequiresproperalignment}
+           current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
+{$endif cpurequiresproperalignment}
+           current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(def.size));
+           fieldcnt:=fields_count(def.symtable,rt);
+           current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(fieldcnt));
+           fields_write_rtti_data(def.symtable,rt);
+        end;
+
+
+        procedure procvar_rtti(def:tprocvardef);
+
+           procedure write_para(parasym:tparavarsym);
+           var
+             paraspec : byte;
+           begin
+             { only store user visible parameters }
+             if not(vo_is_hidden_para in parasym.varoptions) then
+               begin
+                 case parasym.varspez of
+                   vs_value: paraspec := 0;
+                   vs_const: paraspec := pfConst;
+                   vs_var  : paraspec := pfVar;
+                   vs_out  : paraspec := pfOut;
+                 end;
+                 { write flags for current parameter }
+                 current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(paraspec));
+                 { write name of current parameter }
+                 current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(parasym.realname)));
+                 current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(parasym.realname));
+                 { write name of type of current parameter }
+                 write_rtti_name(parasym.vardef);
+               end;
+           end;
+
+        var
+          methodkind : byte;
+          i : integer;
+        begin
+          if po_methodpointer in def.procoptions then
+            begin
+               { write method id and name }
+               current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkmethod));
+               write_rtti_name(def);
+{$ifdef cpurequiresproperalignment}
+               current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
+{$endif cpurequiresproperalignment}
+
+               { write kind of method (can only be function or procedure)}
+               if def.returndef = voidtype then
+                 methodkind := mkProcedure
+               else
+                 methodkind := mkFunction;
+               current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(methodkind));
+
+               { write parameter info. The parameters must be written in reverse order
+                 if this method uses right to left parameter pushing! }
+               current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(def.maxparacount));
+               if def.proccalloption in pushleftright_pocalls then
+                 begin
+                   for i:=0 to def.paras.count-1 do
+                     write_para(tparavarsym(def.paras[i]));
+                 end
+               else
+                 begin
+                   for i:=def.paras.count-1 downto 0 do
+                     write_para(tparavarsym(def.paras[i]));
+                 end;
+
+               { write name of result type }
+               write_rtti_name(def.returndef);
+            end
+          else
+            begin
+              current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkprocvar));
+              write_rtti_name(def);
+            end;
+        end;
+
+
+        procedure objectdef_rtti(def:tobjectdef);
+
+          procedure objectdef_rtti_class_init(def:tobjectdef);
+          begin
+            current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(def.size));
+            current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(fields_count(def.symtable,rt)));
+            fields_write_rtti_data(def.symtable,rt);
+          end;
+
+          procedure objectdef_rtti_interface_init(def:tobjectdef);
+          begin
+            current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(def.size));
+          end;
+
+          procedure objectdef_rtti_class_full(def:tobjectdef);
+          var
+            propnamelist : TFPHashObjectList;
+          begin
+            { Collect unique property names with nameindex }
+            propnamelist:=TFPHashObjectList.Create;
+            collect_propnamelist(propnamelist,def);
+
+            if (oo_has_vmt in def.objectoptions) then
+              current_asmdata.asmlists[al_rtti].concat(Tai_const.Createname(def.vmt_mangledname,0))
+            else
+              current_asmdata.asmlists[al_rtti].concat(Tai_const.create_sym(nil));
+
+            { write parent typeinfo }
+            if assigned(def.childof) and
+               (oo_can_have_published in def.childof.objectoptions) then
+              current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.childof,fullrtti)))
+            else
+              current_asmdata.asmlists[al_rtti].concat(Tai_const.create_sym(nil));
+
+            { total number of unique properties }
+            current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(propnamelist.count));
+
+            { write unit name }
+            current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(current_module.realmodulename^)));
+            current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(current_module.realmodulename^));
+{$ifdef cpurequiresproperalignment}
+            current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
+{$endif cpurequiresproperalignment}
+
+            { write published properties for this object }
+            current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(published_properties_count(def.symtable)));
+{$ifdef cpurequiresproperalignment}
+            current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
+{$endif cpurequiresproperalignment}
+            published_properties_write_rtti_data(propnamelist,def.symtable);
+
+            propnamelist.free;
+          end;
+
+          procedure objectdef_rtti_interface_full(def:tobjectdef);
+          var
+            i : longint;
+            propnamelist : TFPHashObjectList;
+          begin
+            { Collect unique property names with nameindex }
+            propnamelist:=TFPHashObjectList.Create;
+            collect_propnamelist(propnamelist,def);
+
+            { write parent typeinfo }
+            if assigned(def.childof) then
+              current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.childof,fullrtti)))
+            else
+              current_asmdata.asmlists[al_rtti].concat(Tai_const.create_sym(nil));
+
+            { interface: write flags, iid and iidstr }
+            current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(
+              { ugly, but working }
+              longint([
+                TCompilerIntfFlag(ord(ifHasGuid)*ord(assigned(def.iidguid))),
+                TCompilerIntfFlag(ord(ifHasStrGUID)*ord(assigned(def.iidstr)))
+              ])
+              {
+              ifDispInterface,
+              ifDispatch, }
+              ));
+{$ifdef cpurequiresproperalignment}
+            current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
+{$endif cpurequiresproperalignment}
+            current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(longint(def.iidguid^.D1)));
+            current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(def.iidguid^.D2));
+            current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(def.iidguid^.D3));
+            for i:=Low(def.iidguid^.D4) to High(def.iidguid^.D4) do
+              current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(def.iidguid^.D4[i]));
+
+            { write unit name }
+            current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(current_module.realmodulename^)));
+            current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(current_module.realmodulename^));
+{$ifdef cpurequiresproperalignment}
+            current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
+{$endif cpurequiresproperalignment}
+
+            { write iidstr }
+            if assigned(def.iidstr) then
+              begin
+                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(def.iidstr^)));
+                current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(def.iidstr^));
+              end
+            else
+              current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(0));
+{$ifdef cpurequiresproperalignment}
+            current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
+{$endif cpurequiresproperalignment}
+
+            { write published properties for this object }
+            published_properties_write_rtti_data(propnamelist,def.symtable);
+
+            propnamelist.free;
+          end;
+
+        begin
+           case def.objecttype of
+             odt_class:
+               current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkclass));
+             odt_object:
+               current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkobject));
+             odt_interfacecom:
+               current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkinterface));
+             odt_interfacecorba:
+               current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkinterfaceCorba));
+             else
+               internalerror(200611034);
+           end;
+
+           { generate the name }
+           current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(def.objrealname^)));
+           current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(def.objrealname^));
+{$ifdef cpurequiresproperalignment}
+           current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
+{$endif cpurequiresproperalignment}
+
+           case rt of
+             initrtti :
+               begin
+                 if def.objecttype in [odt_class,odt_object] then
+                   objectdef_rtti_class_init(def)
+                 else
+                   objectdef_rtti_interface_init(def);
+               end;
+             fullrtti :
+               begin
+                 if def.objecttype in [odt_class,odt_object] then
+                   objectdef_rtti_class_full(def)
+                 else
+                   objectdef_rtti_interface_full(def);
+               end;
+           end;
+        end;
+
+      begin
+        case def.typ of
+          variantdef :
+            variantdef_rtti(tvariantdef(def));
+          stringdef :
+            stringdef_rtti(tstringdef(def));
+          enumdef :
+            enumdef_rtti(tenumdef(def));
+          orddef :
+            orddef_rtti(torddef(def));
+          floatdef :
+            floatdef_rtti(tfloatdef(def));
+          setdef :
+            setdef_rtti(tsetdef(def));
+          arraydef :
+            begin
+              if ado_IsBitPacked in tarraydef(def).arrayoptions then
+                unknown_rtti(tstoreddef(def))
+              else
+                arraydef_rtti(tarraydef(def));
+            end;
+          recorddef :
+            begin
+              if trecorddef(def).is_packed then
+                unknown_rtti(tstoreddef(def))
+              else
+                recorddef_rtti(trecorddef(def));
+            end;
+          objectdef :
+            objectdef_rtti(tobjectdef(def));
+          else
+            unknown_rtti(tstoreddef(def));
+        end;
+      end;
+
+
+    procedure TRTTIWriter.write_child_rtti_data(def:tdef;rt:trttitype);
+      begin
+        case def.typ of
+          enumdef :
+            if assigned(tenumdef(def).basedef) then
+              write_rtti(tenumdef(def).basedef,rt);
+          setdef :
+            write_rtti(tsetdef(def).elementdef,rt);
+          arraydef :
+            write_rtti(tarraydef(def).elementdef,rt);
+          recorddef :
+            fields_write_rtti(trecorddef(def).symtable,rt);
+          objectdef :
+            if rt=initrtti then
+              fields_write_rtti(tobjectdef(def).symtable,rt)
+            else
+              published_write_rtti(tobjectdef(def).symtable,rt);
+        end;
+      end;
+
+
+    function TRTTIWriter.ref_rtti(def:tdef;rt:trttitype):tasmsymbol;
+      begin
+        if not(rttidefopt[rt] in def.defoptions) then
+          internalerror(200611037);
+        result:=current_asmdata.RefAsmSymbol(def.rtti_mangledname(rt));
+      end;
+      
+      
+    procedure TRTTIWriter.write_rtti(def:tdef;rt:trttitype);
+      var
+        rttilab : tasmsymbol;
+      begin
+        if rttidefopt[rt] in def.defoptions then
+          exit;
+        { only write the rttis of defs defined in the current unit,
+          otherwise we will generate duplicate asmsymbols }
+        if not findunitsymtable(def.owner).iscurrentunit then
+          internalerror(200611035);
+        { prevent recursion }
+        include(def.defoptions,rttidefopt[rt]);
+        { 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);
+        maybe_new_object_file(current_asmdata.asmlists[al_rtti]);
+        new_section(current_asmdata.asmlists[al_rtti],sec_rodata,rttilab.name,const_align(sizeof(aint)));
+        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));
+      end;
+
+
+    function TRTTIWriter.get_rtti_label(def:tdef;rt:trttitype):tasmsymbol;
+      begin
+        if not(rttidefopt[rt] in def.defoptions) then
+          write_rtti(def,rt);
+        result:=ref_rtti(def,rt);
+      end;
+
+end.
+

compiler/ncgutil.pas

@@ -143,10 +143,6 @@ interface
     procedure gen_alloc_symtable(list:TAsmList;st:TSymtable);
     procedure gen_free_symtable(list:TAsmList;st:TSymtable);
 
-    { rtti and init/final }
-    procedure generate_rtti(p:Ttypesym);
-    procedure generate_inittable(p:tsym);
-
     procedure location_free(list: TAsmList; const location : TLocation);
 
     function getprocalign : shortint;
@@ -2660,81 +2656,6 @@ implementation
       end;
 
 
-    { persistent rtti generation }
-    procedure generate_rtti(p:Ttypesym);
-      var
-        rsym : trttisym;
-        def  : tstoreddef;
-      begin
-        { rtti can only be generated for classes that are always typesyms }
-        def:=tstoreddef(ttypesym(p).typedef);
-        { there is an error, skip rtti info }
-        if (def.typ=errordef) or (Errorcount>0) then
-          exit;
-        { only create rtti once for each definition }
-        if not(df_has_rttitable in def.defoptions) then
-         begin
-           { definition should be in the same symtable as the symbol }
-           if p.owner<>def.owner then
-            internalerror(200108262);
-           { create rttisym }
-           rsym:=trttisym.create(p.name,fullrtti);
-           p.owner.insert(rsym);
-           { register rttisym in definition }
-           include(def.defoptions,df_has_rttitable);
-           def.rttitablesym:=rsym;
-           { write rtti data }
-           def.write_child_rtti_data(fullrtti);
-           maybe_new_object_file(current_asmdata.asmlists[al_rtti]);
-           new_section(current_asmdata.asmlists[al_rtti],sec_rodata,rsym.get_label.name,const_align(sizeof(aint)));
-           current_asmdata.asmlists[al_rtti].concat(Tai_symbol.Create_global(rsym.get_label,0));
-           def.write_rtti_data(fullrtti);
-           current_asmdata.asmlists[al_rtti].concat(Tai_symbol_end.Create(rsym.get_label));
-         end;
-      end;
-
-
-    { persistent init table generation }
-    procedure generate_inittable(p:tsym);
-      var
-        rsym : trttisym;
-        def  : tstoreddef;
-      begin
-        { anonymous types are also allowed for records that can be varsym }
-        case p.typ of
-          typesym :
-            def:=tstoreddef(ttypesym(p).typedef);
-          globalvarsym,
-          localvarsym,
-          paravarsym :
-            def:=tstoreddef(tabstractvarsym(p).vardef);
-          else
-            internalerror(200108263);
-        end;
-        { only create inittable once for each definition }
-        if not(df_has_inittable in def.defoptions) then
-         begin
-           { definition should be in the same symtable as the symbol }
-           if p.owner<>def.owner then
-            internalerror(200108264);
-           { create rttisym }
-           rsym:=trttisym.create(p.name,initrtti);
-           p.owner.insert(rsym);
-           { register rttisym in definition }
-           include(def.defoptions,df_has_inittable);
-           def.inittablesym:=rsym;
-           { write inittable data }
-           def.write_child_rtti_data(initrtti);
-           maybe_new_object_file(current_asmdata.asmlists[al_rtti]);
-           new_section(current_asmdata.asmlists[al_rtti],sec_rodata,rsym.get_label.name,const_align(sizeof(aint)));
-           current_asmdata.asmlists[al_rtti].concat(Tai_symbol.Create_global(rsym.get_label,0));
-           def.write_rtti_data(initrtti);
-           current_asmdata.asmlists[al_rtti].concat(Tai_symbol_end.Create(rsym.get_label));
-         end;
-      end;
-
-
-
     procedure gen_intf_wrapper(list:TAsmList;_class:tobjectdef);
       var
         i,j  : longint;

compiler/nobj.pas

@@ -110,6 +110,7 @@ interface
         function  genstrmsgtab : tasmlabel;
         function  genintmsgtab : tasmlabel;
         function  genpublishedmethodstable : tasmlabel;
+        function  generate_field_table : tasmlabel;
         { generates a VMT entries }
         procedure genvmt;
 {$ifdef WITHDMT}
@@ -130,7 +131,8 @@ implementation
        SysUtils,
        globals,verbose,systems,
        symtable,symconst,symtype,defcmp,
-       dbgbase
+       dbgbase,
+       ncgrtti
        ;
 
 
@@ -512,6 +514,80 @@ implementation
       end;
 
 
+    function tclassheader.generate_field_table : tasmlabel;
+      var
+        i   : longint;
+        sym : tsym;
+        fieldtable,
+        classtable : tasmlabel;
+        classindex,
+        fieldcount : longint;
+        classtablelist : TFPList;
+      begin
+        classtablelist:=TFPList.Create;
+        current_asmdata.getdatalabel(fieldtable);
+        current_asmdata.getdatalabel(classtable);
+        maybe_new_object_file(current_asmdata.asmlists[al_rtti]);
+        new_section(current_asmdata.asmlists[al_rtti],sec_rodata,classtable.name,const_align(sizeof(aint)));
+
+        { retrieve field info fields }
+        fieldcount:=0;
+        for i:=0 to _class.symtable.SymList.Count-1 do
+          begin
+            sym:=tsym(_class.symtable.SymList[i]);
+            if (tsym(sym).typ=fieldvarsym) and
+               (sp_published in tsym(sym).symoptions) then
+             begin
+                if tfieldvarsym(sym).vardef.typ<>objectdef then
+                  internalerror(200611032);
+                classindex:=classtablelist.IndexOf(tfieldvarsym(sym).vardef);
+                if classindex=-1 then
+                  classtablelist.Add(tfieldvarsym(sym).vardef);
+                inc(fieldcount);
+             end;
+          end;
+
+        { write fields }
+        current_asmdata.asmlists[al_rtti].concat(Tai_label.Create(fieldtable));
+        current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(fieldcount));
+{$ifdef cpurequiresproperalignment}
+        current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
+{$endif cpurequiresproperalignment}
+        current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(classtable));
+        for i:=0 to _class.symtable.SymList.Count-1 do
+          begin
+            sym:=tsym(_class.symtable.SymList[i]);
+            if (tsym(sym).typ=fieldvarsym) and
+               (sp_published in tsym(sym).symoptions) then
+              begin
+{$ifdef cpurequiresproperalignment}
+                current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(AInt)));
+{$endif cpurequiresproperalignment}
+                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_aint(tfieldvarsym(sym).fieldoffset));
+                classindex:=classtablelist.IndexOf(tfieldvarsym(sym).vardef);
+                if classindex=-1 then
+                  internalerror(200611033);
+                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(classindex+1));
+                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(tfieldvarsym(sym).realname)));
+                current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(tfieldvarsym(sym).realname));
+              end;
+          end;
+
+        { generate the class table }
+        current_asmdata.asmlists[al_rtti].concat(cai_align.create(const_align(sizeof(aint))));
+        current_asmdata.asmlists[al_rtti].concat(Tai_label.Create(classtable));
+        current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(classtablelist.count));
+{$ifdef cpurequiresproperalignment}
+        current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
+{$endif cpurequiresproperalignment}
+        for i:=0 to classtablelist.Count-1 do
+          current_asmdata.asmlists[al_rtti].concat(Tai_const.Createname(tobjectdef(classtablelist[i]).vmt_mangledname,0));
+
+        classtablelist.free;
+        result:=fieldtable;
+      end;
+
+
 {**************************************
                VMT
 **************************************}
@@ -1292,7 +1368,7 @@ implementation
               interfacetable:=genintftable;
 
             methodnametable:=genpublishedmethodstable;
-            fieldtablelabel:=_class.generate_field_table;
+            fieldtablelabel:=generate_field_table;
             { write class name }
             current_asmdata.asmlists[al_globals].concat(Tai_label.Create(classnamelabel));
             current_asmdata.asmlists[al_globals].concat(Tai_const.Create_8bit(length(_class.objrealname^)));
@@ -1349,12 +1425,12 @@ implementation
             current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(fieldtablelabel));
             { pointer to type info of published section }
             if (oo_can_have_published in _class.objectoptions) then
-              current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(_class.get_rtti_label(fullrtti)))
+              current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(RTTIWriter.get_rtti_label(_class,fullrtti)))
             else
               current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(nil));
             { inittable for con-/destruction }
             if _class.members_need_inittable then
-              current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(_class.get_rtti_label(initrtti)))
+              current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(RTTIWriter.get_rtti_label(_class,initrtti)))
             else
               current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(nil));
             { auto table }

compiler/parser.pas

@@ -49,7 +49,7 @@ implementation
       script,gendef,
       comphook,
       scanner,scandir,
-      pbase,ptype,psystem,pmodules,psub,
+      pbase,ptype,psystem,pmodules,psub,ncgrtti,
       cresstr,cpuinfo,procinfo;
 
 
@@ -97,6 +97,9 @@ implementation
          if stacksize=0 then
            stacksize:=target_info.stacksize;
 
+         { RTTI writer }
+         RTTIWriter:=TRTTIWriter.Create;
+
          { open assembler response }
          if cs_link_on_target in current_settings.globalswitches then
            GenerateAsmRes(outputexedir+ChangeFileExt(inputfilename,'_ppas'))
@@ -158,6 +161,8 @@ implementation
          { close scanner }
          DoneScanner;
 
+         RTTIWriter.free;
+
          { close ppas,deffile }
          asmres.free;
          deffile.free;

compiler/pdecl.pas

@@ -59,7 +59,7 @@ implementation
        { pass 1 }
        nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,nobj,
        { codegen }
-       ncgutil,
+       ncgutil,ncgrtti,
        { parser }
        scanner,
        pbase,pexpr,ptype,ptconst,pdecsub,pdecvar,pdecobj,
@@ -562,40 +562,42 @@ implementation
 
               { generate persistent init/final tables when it's declared in the interface so it can
                 be reused in other used }
-              if current_module.in_interface and
-                 ((is_class(hdef) and
-                   tobjectdef(hdef).members_need_inittable) or
-                  hdef.needs_inittable) then
-                generate_inittable(newtype);
+              if current_module.in_interface {or
+                 (
+                  (is_class(hdef) and
+                  tobjectdef(hdef).members_need_inittable) or
+                  hdef.needs_inittable
+                 ) }
+                 then
+                RTTIWriter.write_rtti(hdef,initrtti);
 
               { for objects we should write the vmt and interfaces.
                 This need to be done after the rtti has been written, because
                 it can contain a reference to that data (PFV)
                 This is not for forward classes }
-              if (hdef.typ=objectdef) and
-                 (hdef.owner.symtabletype in [staticsymtable,globalsymtable]) then
-                with Tobjectdef(hdef) do
-                  begin
-                    if not(oo_is_forward in objectoptions) then
-                      begin
-                        ch:=tclassheader.create(tobjectdef(hdef));
-                        { generate and check virtual methods, must be done
-                          before RTTI is written }
-                        ch.genvmt;
-                        { Generate RTTI for class }
-                        generate_rtti(newtype);
-                        if is_interface(tobjectdef(hdef)) then
-                          ch.writeinterfaceids;
-                        if (oo_has_vmt in objectoptions) then
-                          ch.writevmt;
-                        ch.free;
-                      end;
-                   end
+              if (hdef.typ=objectdef) then
+                begin
+                  if not(oo_is_forward in tobjectdef(hdef).objectoptions) then
+                    begin
+                      ch:=tclassheader.create(tobjectdef(hdef));
+                      { generate and check virtual methods, must be done
+                        before RTTI is written }
+                      ch.genvmt;
+                      { Generate RTTI for class }
+                      RTTIWriter.write_rtti(hdef,fullrtti);
+                      if is_interface(tobjectdef(hdef)) then
+                        ch.writeinterfaceids;
+                      if (oo_has_vmt in tobjectdef(hdef).objectoptions) then
+                        ch.writevmt;
+                      ch.free;
+                    end;
+                end
               else
                 begin
                   { Always generate RTTI info for all types. This is to have typeinfo() return
                     the same pointer }
-                  generate_rtti(newtype);
+                  if current_module.in_interface then
+                    RTTIWriter.write_rtti(hdef,fullrtti);
                 end;
 
               current_filepos:=oldfilepos;

compiler/powerpc/cpupi.pas

@@ -58,7 +58,7 @@ unit cpupi;
        cpubase,
        aasmtai,aasmdata,
        tgobj,cgobj,
-       symconst,symsym,paramgr,symutil,
+       symconst,symsym,paramgr,symutil,symtable,
        verbose;
 
     constructor tppcprocinfo.create(aparent:tprocinfo);
@@ -74,7 +74,6 @@ unit cpupi;
     procedure tppcprocinfo.set_first_temp_offset;
       var
          ofs : aword;
-         locals: longint;
       begin
         if not(po_assembler in procdef.procoptions) then
           begin
@@ -90,9 +89,7 @@ unit cpupi;
           end
         else
           begin
-            locals := 0;
-            current_procinfo.procdef.localst.SymList.ForEachCall(@count_locals,@locals);
-            if locals <> 0 then
+            if tabstractlocalsymtable(current_procinfo.procdef.localst).count_locals <> 0 then
               begin
                 { at 0(r1), the previous value of r1 will be stored }
                 tg.setfirsttemp(4);

compiler/powerpc64/cpupi.pas

@@ -50,7 +50,7 @@ uses
   cpubase, cgbase,
   aasmtai,aasmdata,
   tgobj,
-  symconst, symsym, paramgr, symutil,
+  symconst, symsym, paramgr, symutil, symtable,
   verbose;
 
 constructor tppcprocinfo.create(aparent: tprocinfo);
@@ -64,7 +64,6 @@ end;
 procedure tppcprocinfo.set_first_temp_offset;
 var
   ofs: aword;
-  locals: longint;
 begin
   if not (po_assembler in procdef.procoptions) then begin
     { align the stack properly }
@@ -78,9 +77,7 @@ begin
     end;
     tg.setfirsttemp(ofs);
   end else begin
-    locals := 0;
-    current_procinfo.procdef.localst.SymList.ForEachCall(@count_locals, @locals);
-    if locals <> 0 then
+    if tabstractlocalsymtable(current_procinfo.procdef.localst).count_locals <> 0 then
       { at 0(r1), the previous value of r1 will be stored }
       tg.setfirsttemp(8);
   end;

compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion=68;
+  CurrentPPUVersion=69;
 
 { buffer sizes }
   maxentrysize = 1024;
@@ -97,7 +97,7 @@ const
   ibunitsym        = 29;
   iblabelsym       = 30;
   ibsyssym         = 31;
-  ibrttisym        = 32;
+//  ibrttisym        = 32;
   iblocalvarsym    = 33;
   ibparavarsym     = 34;
   ibmacrosym       = 35;

compiler/pstatmnt.pas

@@ -1168,9 +1168,8 @@ implementation
                - target processor has optional frame pointer save
                  (vm, i386, vm only currently)
              }
-             locals:=0;
-             current_procinfo.procdef.localst.SymList.ForEachCall(@count_locals,@locals);
-             current_procinfo.procdef.parast.SymList.ForEachCall(@count_locals,@locals);
+             locals:=tabstractlocalsymtable(current_procinfo.procdef.localst).count_locals+
+                     tabstractlocalsymtable(current_procinfo.procdef.parast).count_locals;
              if (locals=0) and
                 (current_procinfo.procdef.owner.symtabletype<>ObjectSymtable) and
                 (not assigned(current_procinfo.procdef.funcretsym) or

compiler/psystem.pas

@@ -43,7 +43,8 @@ implementation
       globals,globtype,verbose,
       systems,
       symconst,symtype,symsym,symdef,symtable,
-      aasmtai,aasmdata,aasmcpu,ncgutil,fmodule,
+      aasmtai,aasmdata,aasmcpu,
+      ncgutil,ncgrtti,fmodule,
       node,nbas,nflw,nset,ncon,ncnv,nld,nmem,ncal,nmat,nadd,ninl,nopt
       ;
 
@@ -111,14 +112,9 @@ implementation
         begin
           result:=ttypesym.create(s,def);
           systemunit.insert(result);
-          { add init/final table if required }
-          if def.needs_inittable then
-           generate_inittable(result);
-        end;
-
-        procedure adddef(const s:string;def:tdef);
-        begin
-          systemunit.insert(ttypesym.create(s,def));
+          { write always RTTI to get persistent typeinfo }
+          RTTIWriter.write_rtti(def,initrtti);
+          RTTIWriter.write_rtti(def,fullrtti);
         end;
 
       var
@@ -235,7 +231,7 @@ implementation
           end;
 {$ifdef x86}
         if target_info.system<>system_x86_64_win64 then
-          adddef('Comp',tfloatdef.create(s64comp));
+          addtype('Comp',tfloatdef.create(s64comp));
 {$endif x86}
         addtype('Currency',s64currencytype);
         addtype('Pointer',voidpointertype);
@@ -264,8 +260,8 @@ implementation
         addtype('Int64',s64inttype);
         addtype('Char',cchartype);
         addtype('WideChar',cwidechartype);
-        adddef('Text',tfiledef.createtext);
-        adddef('TypedFile',tfiledef.createtyped(voidtype));
+        addtype('Text',tfiledef.createtext);
+        addtype('TypedFile',tfiledef.createtyped(voidtype));
         addtype('Variant',cvarianttype);
         addtype('OleVariant',colevarianttype);
         { Internal types }
@@ -307,6 +303,10 @@ implementation
         hrecst:=trecordsymtable.create(current_settings.packrecords);
         vmttype:=trecorddef.create(hrecst);
         pvmttype:=tpointerdef.create(vmttype);
+        { can't use addtype for pvmt because the rtti of the pointed
+          type is not available. The rtti for pvmt will be written implicitly
+          by thev tblarray below }
+        systemunit.insert(ttypesym.create('$pvmt',pvmttype));
         hrecst.insertfield(tfieldvarsym.create('$parent',vs_value,pvmttype,[]));
         hrecst.insertfield(tfieldvarsym.create('$length',vs_value,s32inttype,[]));
         hrecst.insertfield(tfieldvarsym.create('$mlength',vs_value,s32inttype,[]));
@@ -314,7 +314,6 @@ implementation
         tarraydef(vmtarraytype).elementdef:=voidpointertype;
         hrecst.insertfield(tfieldvarsym.create('$__pfn',vs_value,vmtarraytype,[]));
         addtype('$__vtbl_ptr_type',vmttype);
-        addtype('$pvmt',pvmttype);
         vmtarraytype:=tarraydef.create(0,1,s32inttype);
         tarraydef(vmtarraytype).elementdef:=pvmttype;
         addtype('$vtblarray',vmtarraytype);

compiler/symconst.pas

@@ -386,7 +386,7 @@ type
     globalvarsym,localvarsym,paravarsym,fieldvarsym,
     typesym,procsym,unitsym,constsym,enumsym,typedconstsym,
     errorsym,syssym,labelsym,absolutevarsym,propertysym,
-    macrosym,rttisym
+    macrosym
   );
 
   { State of the variable, if it's declared, assigned or used }
@@ -442,7 +442,7 @@ const
        'abstractsym','globalvar','localvar','paravar','fieldvar',
        'type','proc','unit','const','enum','typed const',
        'errorsym','system sym','label','absolutevar','property',
-       'macrosym','rttisym'
+       'macrosym'
      );
 
      typName : array[tdeftyp] of string[12] = (

compiler/symdef.pas

@@ -48,17 +48,12 @@ interface
                     TDef
 ************************************************}
 
+       { tstoreddef }
+
        tstoreddef = class(tdef)
        protected
           typesymderef  : tderef;
        public
-          { persistent (available across units) rtti and init tables }
-          rttitablesym,
-          inittablesym  : tsym; {trttisym}
-          rttitablesymderef,
-          inittablesymderef : tderef;
-          { local (per module) rtti and init tables }
-          localrttilab  : array[trttitype] of tasmlabel;
 {$ifdef EXTDEBUG}
           fileinfo   : tfileposinfo;
 {$endif}
@@ -82,11 +77,7 @@ interface
           function  alignment:shortint;override;
           function  is_publishable : boolean;override;
           function  needs_inittable : boolean;override;
-          { rtti generation }
-          procedure write_rtti_name;
-          procedure write_rtti_data(rt:trttitype);virtual;
-          procedure write_child_rtti_data(rt:trttitype);virtual;
-          function  get_rtti_label(rt:trttitype):tasmsymbol;
+          function  rtti_mangledname(rt:trttitype):string;override;
           { regvars }
           function is_intregable : boolean;
           function is_fpuregable : boolean;
@@ -125,7 +116,6 @@ interface
           procedure setsize;
           function is_publishable : boolean;override;
           function needs_inittable : boolean;override;
-          procedure write_rtti_data(rt:trttitype);override;
        end;
 
        tformaldef = class(tstoreddef)
@@ -178,13 +168,6 @@ interface
        end;
 
        tabstractrecorddef= class(tstoreddef)
-       private
-          Count         : integer;
-          FRTTIType     : trttitype;
-          procedure count_field_rtti(sym:TObject;arg:pointer);
-          procedure write_field_rtti(sym:TObject;arg:pointer);
-          procedure generate_field_rtti(sym:TObject;arg:pointer);
-       public
           symtable : TSymtable;
           procedure reset;override;
           function  GetSymtable(t:tGetSymtable):TSymtable;override;
@@ -207,9 +190,6 @@ interface
           function  GetTypeName:string;override;
           { debug }
           function  needs_inittable : boolean;override;
-          { rtti }
-          procedure write_child_rtti_data(rt:trttitype);override;
-          procedure write_rtti_data(rt:trttitype);override;
        end;
 
        tprocdef = class;
@@ -239,13 +219,6 @@ interface
        { tobjectdef }
 
        tobjectdef = class(tabstractrecorddef)
-       private
-          procedure count_published_properties(sym:TObject;arg:pointer);
-          procedure collect_published_properties(sym:TObject;arg:pointer);
-          procedure write_property_info(sym:TObject;arg:pointer);
-          procedure generate_published_child_rtti(sym:TObject;arg:pointer);
-          procedure count_published_fields(sym:TObject;arg:pointer);
-          procedure writefields(sym:TObject;arg:pointer);
        public
           childof        : tobjectdef;
           childofderef   : tderef;
@@ -283,16 +256,11 @@ interface
           function  is_publishable : boolean;override;
           function  needs_inittable : boolean;override;
           function  vmt_mangledname : string;
-          function  rtti_name : string;
           procedure check_forwards;
           function  is_related(d : tdef) : boolean;override;
           procedure insertvmt;
           procedure set_parent(c : tobjectdef);
           function FindDestructor : tprocdef;
-          { rtti }
-          procedure write_child_rtti_data(rt:trttitype);override;
-          procedure write_rtti_data(rt:trttitype);override;
-          function generate_field_table : tasmlabel;
        end;
 
        tclassrefdef = class(tabstractpointerdef)
@@ -330,8 +298,6 @@ interface
           function alignment : shortint;override;
           { returns the label of the range check string }
           function needs_inittable : boolean;override;
-          procedure write_child_rtti_data(rt:trttitype);override;
-          procedure write_rtti_data(rt:trttitype);override;
           property elementdef : tdef read _elementdef write setelementdef;
        end;
 
@@ -348,8 +314,6 @@ interface
           procedure setsize;
           function  packedbitsize: aint; override;
           function getvardef : longint;override;
-          { rtti }
-          procedure write_rtti_data(rt:trttitype);override;
        end;
 
        tfloatdef = class(tstoreddef)
@@ -363,8 +327,6 @@ interface
           function alignment:shortint;override;
           procedure setsize;
           function  getvardef:longint;override;
-          { rtti }
-          procedure write_rtti_data(rt:trttitype);override;
        end;
 
        tabstractprocdef = class(tstoreddef)
@@ -416,8 +378,6 @@ interface
           function  is_methodpointer:boolean;override;
           function  is_addressonly:boolean;override;
           function  getmangledparaname:string;override;
-          { rtti }
-          procedure write_rtti_data(rt:trttitype);override;
        end;
 
        tmessageinf = record
@@ -546,10 +506,7 @@ interface
           function  getmangledparaname:string;override;
           function  is_publishable : boolean;override;
           function alignment : shortint;override;
-          { init/final }
           function  needs_inittable : boolean;override;
-          { rtti }
-          procedure write_rtti_data(rt:trttitype);override;
        end;
 
        tenumdef = class(tstoreddef)
@@ -575,9 +532,6 @@ interface
           procedure setmin(_min:aint);
           function  min:aint;
           function  max:aint;
-          { rtti }
-          procedure write_rtti_data(rt:trttitype);override;
-          procedure write_child_rtti_data(rt:trttitype);override;
        end;
 
        tsetdef = class(tstoreddef)
@@ -594,9 +548,6 @@ interface
           procedure deref;override;
           function  GetTypeName:string;override;
           function  is_publishable : boolean;override;
-          { rtti }
-          procedure write_rtti_data(rt:trttitype);override;
-          procedure write_child_rtti_data(rt:trttitype);override;
        end;
 
        Tdefmatch=(dm_exact,dm_equal,dm_convertl1);
@@ -876,7 +827,6 @@ implementation
 {$ifdef EXTDEBUG}
          fileinfo := current_filepos;
 {$endif}
-         fillchar(localrttilab,sizeof(localrttilab),0);
          generictokenbuf:=nil;
          genericdef:=nil;
          { Don't register forwarddefs, they are disposed at the
@@ -940,14 +890,9 @@ implementation
 {$ifdef EXTDEBUG}
          fillchar(fileinfo,sizeof(fileinfo),0);
 {$endif}
-         fillchar(localrttilab,sizeof(localrttilab),0);
          { load }
          ppufile.getderef(typesymderef);
          ppufile.getsmallset(defoptions);
-         if df_has_rttitable in defoptions then
-          ppufile.getderef(rttitablesymderef);
-         if df_has_inittable in defoptions then
-          ppufile.getderef(inittablesymderef);
          if df_generic in defoptions then
            begin
              sizeleft:=ppufile.getlongint;
@@ -968,14 +913,24 @@ implementation
       end;
 
 
+    function Tstoreddef.rtti_mangledname(rt:trttitype):string;
+      var
+        prefix : string[4];
+      begin
+        if rt=fullrtti then
+          prefix:='RTTI'
+        else
+          prefix:='INIT';
+        if assigned(typesym) and
+           (owner.symtabletype=globalsymtable) then
+          result:=make_mangledname(prefix,owner,typesym.name)
+        else
+          result:=make_mangledname(prefix,findunitsymtable(owner),'DEF'+tostr(DefId))
+      end;
+
+
     procedure Tstoreddef.reset;
       begin
-        if assigned(rttitablesym) then
-          trttisym(rttitablesym).lab := nil;
-        if assigned(inittablesym) then
-          trttisym(inittablesym).lab := nil;
-        localrttilab[initrtti]:=nil;
-        localrttilab[fullrtti]:=nil;
       end;
 
 
@@ -995,10 +950,6 @@ implementation
         ppufile.putlongint(DefId);
         ppufile.putderef(typesymderef);
         ppufile.putsmallset(defoptions);
-        if df_has_rttitable in defoptions then
-         ppufile.putderef(rttitablesymderef);
-        if df_has_inittable in defoptions then
-         ppufile.putderef(inittablesymderef);
         if df_generic in defoptions then
           begin
             oldintfcrc:=ppufile.do_interface_crc;
@@ -1031,8 +982,6 @@ implementation
     procedure tstoreddef.buildderef;
       begin
         typesymderef.build(typesym);
-        rttitablesymderef.build(rttitablesym);
-        inittablesymderef.build(inittablesym);
         genericdefderef.build(genericdef);
       end;
 
@@ -1045,10 +994,6 @@ implementation
     procedure tstoreddef.deref;
       begin
         typesym:=ttypesym(typesymderef.resolve);
-        if df_has_rttitable in defoptions then
-          rttitablesym:=trttisym(rttitablesymderef.resolve);
-        if df_has_inittable in defoptions then
-          inittablesym:=trttisym(inittablesymderef.resolve);
         if df_specialization in defoptions then
           genericdef:=tstoreddef(genericdefderef.resolve);
       end;
@@ -1078,58 +1023,6 @@ implementation
       end;
 
 
-    procedure tstoreddef.write_rtti_name;
-      var
-         str : string;
-      begin
-         { name }
-         if assigned(typesym) then
-           begin
-              str:=ttypesym(typesym).realname;
-              current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(chr(length(str))+str));
-           end
-         else
-           current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(#0))
-      end;
-
-
-    procedure tstoreddef.write_rtti_data(rt:trttitype);
-      begin
-        current_asmdata.asmlists[al_rtti].concat(tai_const.create_8bit(tkUnknown));
-        write_rtti_name;
-      end;
-
-
-    procedure tstoreddef.write_child_rtti_data(rt:trttitype);
-      begin
-      end;
-
-
-    function tstoreddef.get_rtti_label(rt:trttitype) : tasmsymbol;
-      begin
-         { try to reuse persistent rtti data }
-         if (rt=fullrtti) and (df_has_rttitable in defoptions) then
-          get_rtti_label:=trttisym(rttitablesym).get_label
-         else
-          if (rt=initrtti) and (df_has_inittable in defoptions) then
-           get_rtti_label:=trttisym(inittablesym).get_label
-         else
-          begin
-            if not assigned(localrttilab[rt]) then
-             begin
-               current_asmdata.getdatalabel(localrttilab[rt]);
-               write_child_rtti_data(rt);
-               maybe_new_object_file(current_asmdata.asmlists[al_rtti]);
-               new_section(current_asmdata.asmlists[al_rtti],sec_rodata,localrttilab[rt].name,const_align(sizeof(aint)));
-               current_asmdata.asmlists[al_rtti].concat(Tai_symbol.Create_global(localrttilab[rt],0));
-               write_rtti_data(rt);
-               current_asmdata.asmlists[al_rtti].concat(Tai_symbol_end.Create(localrttilab[rt]));
-             end;
-            get_rtti_label:=localrttilab[rt];
-          end;
-      end;
-
-
     { returns true, if the definition can be published }
     function tstoreddef.is_publishable : boolean;
       begin
@@ -1342,37 +1235,6 @@ implementation
       end;
 
 
-    procedure tstringdef.write_rtti_data(rt:trttitype);
-      begin
-         case stringtype of
-            st_ansistring:
-              begin
-                 current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkAString));
-                 write_rtti_name;
-              end;
-            st_widestring:
-              begin
-                 current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkWString));
-                 write_rtti_name;
-              end;
-            st_longstring:
-              begin
-                 current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkLString));
-                 write_rtti_name;
-              end;
-            st_shortstring:
-              begin
-                 current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkSString));
-                 write_rtti_name;
-                 current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(len));
-{$ifdef cpurequiresproperalignment}
-                 current_asmdata.asmlists[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
-              end;
-         end;
-      end;
-
-
     function tstringdef.getmangledparaname : string;
       begin
         getmangledparaname:='STRING';
@@ -1544,61 +1406,18 @@ implementation
       end;
 
 
-    procedure tenumdef.write_child_rtti_data(rt:trttitype);
-      begin
-         if assigned(basedef) then
-           basedef.get_rtti_label(rt);
-      end;
-
-
-    procedure tenumdef.write_rtti_data(rt:trttitype);
-      var
-         hp : tenumsym;
-      begin
-         current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkEnumeration));
-         write_rtti_name;
-{$ifdef cpurequiresproperalignment}
-         current_asmdata.asmlists[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
-         case longint(savesize) of
-            1:
-              current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otUByte));
-            2:
-              current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otUWord));
-            4:
-              current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otULong));
-         end;
-{$ifdef cpurequiresproperalignment}
-         current_asmdata.asmlists[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
-         current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(min));
-         current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(max));
-         if assigned(basedef) then
-           current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(basedef.get_rtti_label(rt)))
-         else
-           current_asmdata.asmlists[al_rtti].concat(Tai_const.create_sym(nil));
-         hp:=tenumsym(firstenum);
-         while assigned(hp) do
-           begin
-              current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(hp.realname)));
-              current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(hp.realname));
-              hp:=hp.nextenum;
-           end;
-         current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(0));
-      end;
-
-
     function tenumdef.is_publishable : boolean;
       begin
          is_publishable:=true;
       end;
 
-    function tenumdef.GetTypeName : string;
 
+    function tenumdef.GetTypeName : string;
       begin
          GetTypeName:='<enumeration type>';
       end;
 
+
 {****************************************************************************
                                  TORDDEF
 ****************************************************************************}
@@ -1722,79 +1541,6 @@ implementation
       end;
 
 
-    procedure torddef.write_rtti_data(rt:trttitype);
-
-        procedure dointeger;
-        const
-          trans : array[tordtype] of byte =
-            (otUByte{otNone},
-             otUByte,otUWord,otULong,otUByte{otNone},
-             otSByte,otSWord,otSLong,otUByte{otNone},
-             otUByte,otUWord,otULong,otUByte,
-             otUByte,otUWord,otUByte);
-        begin
-          write_rtti_name;
-{$ifdef cpurequiresproperalignment}
-          current_asmdata.asmlists[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
-          current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(byte(trans[ordtype])));
-{$ifdef cpurequiresproperalignment}
-         current_asmdata.asmlists[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
-          current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(longint(low)));
-          current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(longint(high)));
-        end;
-
-      begin
-        case ordtype of
-          s64bit :
-            begin
-              current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkInt64));
-              write_rtti_name;
-{$ifdef cpurequiresproperalignment}
-              current_asmdata.asmlists[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
-              { low }
-              current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_64bit(int64($80000000) shl 32));
-              { high }
-              current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_64bit((int64($7fffffff) shl 32) or int64($ffffffff)));
-            end;
-          u64bit :
-            begin
-              current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkQWord));
-              write_rtti_name;
-{$ifdef cpurequiresproperalignment}
-              current_asmdata.asmlists[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
-              { low }
-              current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_64bit(0));
-              { high }
-              current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_64bit(int64((int64($ffffffff) shl 32) or int64($ffffffff))));
-            end;
-          bool8bit:
-            begin
-              current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkBool));
-              dointeger;
-            end;
-          uchar:
-            begin
-              current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkChar));
-              dointeger;
-            end;
-          uwidechar:
-            begin
-              current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkWChar));
-              dointeger;
-            end;
-          else
-            begin
-              current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkInteger));
-              dointeger;
-            end;
-        end;
-      end;
-
-
     function torddef.is_publishable : boolean;
       begin
          is_publishable:=(ordtype<>uvoid);
@@ -1802,7 +1548,6 @@ implementation
 
 
     function torddef.GetTypeName : string;
-
       const
         names : array[tordtype] of string[20] = (
           'untyped',
@@ -1815,6 +1560,7 @@ implementation
          GetTypeName:=names[ordtype];
       end;
 
+
 {****************************************************************************
                                 TFLOATDEF
 ****************************************************************************}
@@ -1897,21 +1643,6 @@ implementation
       end;
 
 
-    procedure tfloatdef.write_rtti_data(rt:trttitype);
-      const
-         {tfloattype = (s32real,s64real,s80real,s64bit,s128bit);}
-         translate : array[tfloattype] of byte =
-           (ftSingle,ftDouble,ftExtended,ftComp,ftCurr,ftFloat128);
-      begin
-         current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkFloat));
-         write_rtti_name;
-{$ifdef cpurequiresproperalignment}
-         current_asmdata.asmlists[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
-         current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(translate[floattype]));
-      end;
-
-
     function tfloatdef.is_publishable : boolean;
       begin
          is_publishable:=true;
@@ -2120,12 +1851,6 @@ implementation
       end;
 
 
-    procedure tvariantdef.write_rtti_data(rt:trttitype);
-      begin
-         current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkVariant));
-      end;
-
-
     function tvariantdef.needs_inittable : boolean;
       begin
          needs_inittable:=true;
@@ -2349,27 +2074,6 @@ implementation
       end;
 
 
-    procedure tsetdef.write_child_rtti_data(rt:trttitype);
-      begin
-        tstoreddef(elementdef).get_rtti_label(rt);
-      end;
-
-
-    procedure tsetdef.write_rtti_data(rt:trttitype);
-      begin
-         current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkSet));
-         write_rtti_name;
-{$ifdef cpurequiresproperalignment}
-         current_asmdata.asmlists[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
-         current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otULong));
-{$ifdef cpurequiresproperalignment}
-         current_asmdata.asmlists[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
-         current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(tstoreddef(elementdef).get_rtti_label(rt)));
-      end;
-
-
     function tsetdef.is_publishable : boolean;
       begin
          is_publishable:=(settype=smallset);
@@ -2617,39 +2321,6 @@ implementation
       end;
 
 
-    procedure tarraydef.write_child_rtti_data(rt:trttitype);
-      begin
-        tstoreddef(elementdef).get_rtti_label(rt);
-      end;
-
-
-    procedure tarraydef.write_rtti_data(rt:trttitype);
-      begin
-         if ado_IsBitPacked in arrayoptions then
-           begin
-             current_asmdata.asmlists[al_rtti].concat(tai_const.create_8bit(tkUnknown));
-             write_rtti_name;
-             exit;
-           end;
-         if ado_IsDynamicArray in arrayoptions then
-           current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkdynarray))
-         else
-           current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkarray));
-         write_rtti_name;
-{$ifdef cpurequiresproperalignment}
-         current_asmdata.asmlists[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
-         { size of elements }
-         current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_aint(elesize));
-         if not(ado_IsDynamicArray in arrayoptions) then
-           current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_aint(elecount));
-         { element type }
-         current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(tstoreddef(elementdef).get_rtti_label(rt)));
-         { variant type }
-         current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(tstoreddef(elementdef).getvardef));
-      end;
-
-
     function tarraydef.GetTypeName : string;
       begin
          if (ado_IsConstString in arrayoptions) then
@@ -2715,35 +2386,6 @@ implementation
         result:=tabstractrecordsymtable(symtable).is_packed;
       end;
 
-    procedure tabstractrecorddef.count_field_rtti(sym:TObject;arg:pointer);
-      begin
-         if (FRTTIType=fullrtti) or
-            ((tsym(sym).typ=fieldvarsym) and
-             tfieldvarsym(sym).vardef.needs_inittable) then
-           inc(Count);
-      end;
-
-
-    procedure tabstractrecorddef.generate_field_rtti(sym:TObject;arg:pointer);
-      begin
-         if (FRTTIType=fullrtti) or
-            ((tsym(sym).typ=fieldvarsym) and
-             tfieldvarsym(sym).vardef.needs_inittable) then
-           tstoreddef(tfieldvarsym(sym).vardef).get_rtti_label(FRTTIType);
-      end;
-
-
-    procedure tabstractrecorddef.write_field_rtti(sym:TObject;arg:pointer);
-      begin
-         if (FRTTIType=fullrtti) or
-            ((tsym(sym).typ=fieldvarsym) and
-             tfieldvarsym(sym).vardef.needs_inittable) then
-          begin
-            current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(tstoreddef(tfieldvarsym(sym).vardef).get_rtti_label(FRTTIType)));
-            current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(tfieldvarsym(sym).fieldoffset));
-          end;
-      end;
-
 
 {***************************************************************************
                                   trecorddef
@@ -2850,35 +2492,6 @@ implementation
       end;
 
 
-    procedure trecorddef.write_child_rtti_data(rt:trttitype);
-      begin
-         FRTTIType:=rt;
-         symtable.SymList.ForEachCall(@generate_field_rtti,nil);
-      end;
-
-
-    procedure trecorddef.write_rtti_data(rt:trttitype);
-      begin
-         if is_packed then
-           begin
-             current_asmdata.asmlists[al_rtti].concat(tai_const.create_8bit(tkUnknown));
-             write_rtti_name;
-             exit;
-           end;
-         current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkrecord));
-         write_rtti_name;
-{$ifdef cpurequiresproperalignment}
-         current_asmdata.asmlists[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
-         current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(size));
-         Count:=0;
-         FRTTIType:=rt;
-         symtable.SymList.ForEachCall(@count_field_rtti,nil);
-         current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(Count));
-         symtable.SymList.ForEachCall(@write_field_rtti,nil);
-      end;
-
-
     function trecorddef.GetTypeName : string;
       begin
          GetTypeName:='<record type>'
@@ -3878,79 +3491,6 @@ implementation
       end;
 
 
-    procedure tprocvardef.write_rtti_data(rt:trttitype);
-
-         procedure write_para(parasym:tparavarsym);
-         var
-           paraspec : byte;
-         begin
-           { only store user visible parameters }
-           if not(vo_is_hidden_para in parasym.varoptions) then
-             begin
-               case parasym.varspez of
-                 vs_value: paraspec := 0;
-                 vs_const: paraspec := pfConst;
-                 vs_var  : paraspec := pfVar;
-                 vs_out  : paraspec := pfOut;
-               end;
-               { write flags for current parameter }
-               current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(paraspec));
-               { write name of current parameter }
-               current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(parasym.realname)));
-               current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(parasym.realname));
-
-               { write name of type of current parameter }
-               tstoreddef(parasym.vardef).write_rtti_name;
-             end;
-         end;
-
-       var
-         methodkind : byte;
-         i : integer;
-      begin
-        if po_methodpointer in procoptions then
-          begin
-             { write method id and name }
-             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkmethod));
-             write_rtti_name;
-
-{$ifdef cpurequiresproperalignment}
-             current_asmdata.asmlists[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
-             { write kind of method (can only be function or procedure)}
-             if returndef = voidtype then
-               methodkind := mkProcedure
-             else
-               methodkind := mkFunction;
-             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(methodkind));
-
-             { get # of parameters }
-             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(maxparacount));
-
-             { write parameter info. The parameters must be written in reverse order
-               if this method uses right to left parameter pushing! }
-             if proccalloption in pushleftright_pocalls then
-               begin
-                 for i:=0 to paras.count-1 do
-                   write_para(tparavarsym(paras[i]));
-               end
-             else
-               begin
-                 for i:=paras.count-1 downto 0 do
-                   write_para(tparavarsym(paras[i]));
-               end;
-
-             { write name of result type }
-             tstoreddef(returndef).write_rtti_name;
-          end
-        else
-          begin
-            current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkprocvar));
-            write_rtti_name;
-          end;
-      end;
-
-
     function tprocvardef.is_publishable : boolean;
       begin
          is_publishable:=(po_methodpointer in procoptions);
@@ -3992,56 +3532,6 @@ implementation
                               TOBJECTDEF
 ***************************************************************************}
 
-    type
-       tproptablelistitem = class(TLinkedListItem)
-          index : longint;
-          def   : tobjectdef;
-       end;
-
-       tpropnamelistitem = class(TLinkedListItem)
-          index : longint;
-          name  : TIDString;
-          owner : TSymtable;
-       end;
-
-    var
-       proptablelist  : tlinkedlist;
-       propnamelist   : tlinkedlist;
-
-    function searchproptablelist(p : tobjectdef) : tproptablelistitem;
-      var
-         hp : tproptablelistitem;
-      begin
-         hp:=tproptablelistitem(proptablelist.first);
-         while assigned(hp) do
-           if hp.def=p then
-             begin
-                result:=hp;
-                exit;
-             end
-           else
-             hp:=tproptablelistitem(hp.next);
-         result:=nil;
-      end;
-
-
-    function searchpropnamelist(const n:string) : tpropnamelistitem;
-      var
-         hp : tpropnamelistitem;
-      begin
-         hp:=tpropnamelistitem(propnamelist.first);
-         while assigned(hp) do
-           if hp.name=n then
-             begin
-                result:=hp;
-                exit;
-             end
-           else
-             hp:=tpropnamelistitem(hp.next);
-         result:=nil;
-      end;
-
-
    constructor tobjectdef.create(ot : tobjecttyp;const n : string;c : tobjectdef);
      begin
         inherited create(objectdef);
@@ -4449,12 +3939,6 @@ implementation
       end;
 
 
-    function tobjectdef.rtti_name : string;
-      begin
-        rtti_name:=make_mangledname('RTTI',owner,objname^);
-      end;
-
-
     function tobjectdef.needs_inittable : boolean;
       begin
          case objecttype of
@@ -4499,402 +3983,6 @@ implementation
       end;
 
 
-    procedure tobjectdef.collect_published_properties(sym:TObject;arg:pointer);
-      var
-        hp : tpropnamelistitem;
-      begin
-         if (tsym(sym).typ=propertysym) and
-            (sp_published in tsym(sym).symoptions) then
-           begin
-             hp:=searchpropnamelist(tsym(sym).name);
-             if not(assigned(hp)) then
-               begin
-                  hp:=tpropnamelistitem.create;
-                  hp.name:=tsym(sym).name;
-                  hp.index:=propnamelist.count;
-                  hp.owner:=tsym(sym).owner;
-                  propnamelist.concat(hp);
-               end;
-          end;
-      end;
-
-
-    procedure tobjectdef.count_published_properties(sym:TObject;arg:pointer);
-      begin
-         if (tsym(sym).typ=propertysym) and
-            (sp_published in tsym(sym).symoptions) then
-           inc(plongint(arg)^);
-      end;
-
-
-    procedure tobjectdef.write_property_info(sym:TObject;arg:pointer);
-      var
-         proctypesinfo : byte;
-         propnameitem  : tpropnamelistitem;
-
-        procedure writeaccessproc(pap:tpropaccesslisttypes; shiftvalue : byte; unsetvalue: byte);
-        var
-           typvalue : byte;
-           hp : ppropaccesslistitem;
-           address : longint;
-           def : tdef;
-           hpropsym : tpropertysym;
-           propaccesslist : tpropaccesslist;
-        begin
-           hpropsym:=tpropertysym(sym);
-           repeat
-             propaccesslist:=hpropsym.propaccesslist[pap];
-             if not propaccesslist.empty then
-               break;
-             hpropsym:=hpropsym.overridenpropsym;
-           until not assigned(hpropsym);
-           if not(assigned(propaccesslist) and assigned(propaccesslist.firstsym))  then
-             begin
-                current_asmdata.asmlists[al_rtti].concat(Tai_const.create(aitconst_ptr,unsetvalue));
-                typvalue:=3;
-             end
-           else if propaccesslist.firstsym^.sym.typ=fieldvarsym then
-             begin
-                address:=0;
-                hp:=propaccesslist.firstsym;
-                def:=nil;
-                while assigned(hp) do
-                  begin
-                     case hp^.sltype of
-                       sl_load :
-                         begin
-                           def:=tfieldvarsym(hp^.sym).vardef;
-                           inc(address,tfieldvarsym(hp^.sym).fieldoffset);
-                         end;
-                       sl_subscript :
-                         begin
-                           if not(assigned(def) and (def.typ=recorddef)) then
-                             internalerror(200402171);
-                           inc(address,tfieldvarsym(hp^.sym).fieldoffset);
-                           def:=tfieldvarsym(hp^.sym).vardef;
-                         end;
-                       sl_vec :
-                         begin
-                           if not(assigned(def) and (def.typ=arraydef)) then
-                             internalerror(200402172);
-                           def:=tarraydef(def).elementdef;
-                           inc(address,def.size*hp^.value);
-                         end;
-                     end;
-                     hp:=hp^.next;
-                  end;
-                current_asmdata.asmlists[al_rtti].concat(Tai_const.create(aitconst_ptr,address));
-                typvalue:=0;
-             end
-           else
-             begin
-                { When there was an error then procdef is not assigned }
-                if not assigned(propaccesslist.procdef) then
-                  exit;
-                if not(po_virtualmethod in tprocdef(propaccesslist.procdef).procoptions) then
-                  begin
-                     current_asmdata.asmlists[al_rtti].concat(Tai_const.createname(tprocdef(propaccesslist.procdef).mangledname,0));
-                     typvalue:=1;
-                  end
-                else
-                  begin
-                     { virtual method, write vmt offset }
-                     current_asmdata.asmlists[al_rtti].concat(Tai_const.create(aitconst_ptr,
-                       tprocdef(propaccesslist.procdef)._class.vmtmethodoffset(tprocdef(propaccesslist.procdef).extnumber)));
-                     typvalue:=2;
-                  end;
-             end;
-           proctypesinfo:=proctypesinfo or (typvalue shl shiftvalue);
-        end;
-
-      begin
-         if (tsym(sym).typ=propertysym) and
-            (sp_published in tsym(sym).symoptions) then
-           begin
-             if ppo_indexed in tpropertysym(sym).propoptions then
-               proctypesinfo:=$40
-             else
-               proctypesinfo:=0;
-             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(tstoreddef(tpropertysym(sym).propdef).get_rtti_label(fullrtti)));
-             writeaccessproc(palt_read,0,0);
-             writeaccessproc(palt_write,2,0);
-             { is it stored ? }
-             if not(ppo_stored in tpropertysym(sym).propoptions) then
-               begin
-                 { no, so put a constant zero }
-                 current_asmdata.asmlists[al_rtti].concat(Tai_const.create(aitconst_ptr,0));
-                 proctypesinfo:=proctypesinfo or (3 shl 4);
-               end
-             else
-               writeaccessproc(palt_stored,4,1); { maybe; if no procedure put a constant 1 (=true) }
-             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(tpropertysym(sym).index));
-             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(tpropertysym(sym).default));
-             propnameitem:=searchpropnamelist(tpropertysym(sym).name);
-             if not assigned(propnameitem) then
-               internalerror(200512201);
-             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(propnameitem.index));
-             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(proctypesinfo));
-             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(tpropertysym(sym).realname)));
-             current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(tpropertysym(sym).realname));
-{$ifdef cpurequiresproperalignment}
-             current_asmdata.asmlists[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
-          end;
-      end;
-
-
-    procedure tobjectdef.generate_published_child_rtti(sym:TObject;arg:pointer);
-      begin
-         if needs_prop_entry(tsym(sym)) then
-          begin
-            case tsym(sym).typ of
-              propertysym:
-                tstoreddef(tpropertysym(sym).propdef).get_rtti_label(fullrtti);
-              fieldvarsym:
-                tstoreddef(tfieldvarsym(sym).vardef).get_rtti_label(fullrtti);
-              else
-                internalerror(1509991);
-            end;
-          end;
-      end;
-
-
-    procedure tobjectdef.write_child_rtti_data(rt:trttitype);
-      begin
-         FRTTIType:=rt;
-         case rt of
-           initrtti :
-             symtable.SymList.ForEachCall(@generate_field_rtti,nil);
-           fullrtti :
-             symtable.SymList.ForEachCall(@generate_published_child_rtti,nil);
-           else
-             internalerror(200108301);
-         end;
-      end;
-
-
-    procedure tobjectdef.count_published_fields(sym:TObject;arg:pointer);
-      var
-         hp : tproptablelistitem;
-      begin
-         if (tsym(sym).typ=fieldvarsym) and
-            (sp_published in tsym(sym).symoptions) then
-          begin
-             if tfieldvarsym(sym).vardef.typ<>objectdef then
-               internalerror(0206001);
-             hp:=searchproptablelist(tobjectdef(tfieldvarsym(sym).vardef));
-             if not(assigned(hp)) then
-               begin
-                  hp:=tproptablelistitem.create;
-                  hp.def:=tobjectdef(tfieldvarsym(sym).vardef);
-                  hp.index:=proptablelist.count+1;
-                  proptablelist.concat(hp);
-               end;
-             inc(plongint(arg)^);
-          end;
-      end;
-
-
-    procedure tobjectdef.writefields(sym:TObject;arg:pointer);
-      var
-         hp : tproptablelistitem;
-      begin
-         if needs_prop_entry(tsym(sym)) and
-          (tsym(sym).typ=fieldvarsym) then
-          begin
-{$ifdef cpurequiresproperalignment}
-             current_asmdata.asmlists[al_rtti].concat(Tai_align.Create(sizeof(AInt)));
-{$endif cpurequiresproperalignment}
-             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_aint(tfieldvarsym(sym).fieldoffset));
-             hp:=searchproptablelist(tobjectdef(tfieldvarsym(sym).vardef));
-             if not(assigned(hp)) then
-               internalerror(0206002);
-             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(hp.index));
-             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(tfieldvarsym(sym).realname)));
-             current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(tfieldvarsym(sym).realname));
-          end;
-      end;
-
-
-    function tobjectdef.generate_field_table : tasmlabel;
-      var
-         fieldtable,
-         classtable : tasmlabel;
-         hp : tproptablelistitem;
-         fieldcount : longint;
-      begin
-         proptablelist:=TLinkedList.Create;
-         current_asmdata.getdatalabel(fieldtable);
-         current_asmdata.getdatalabel(classtable);
-         maybe_new_object_file(current_asmdata.asmlists[al_rtti]);
-         new_section(current_asmdata.asmlists[al_rtti],sec_rodata,classtable.name,const_align(sizeof(aint)));
-         { fields }
-         fieldcount:=0;
-         symtable.SymList.ForEachCall(@count_published_fields,@fieldcount);
-         current_asmdata.asmlists[al_rtti].concat(Tai_label.Create(fieldtable));
-         current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(fieldcount));
-{$ifdef cpurequiresproperalignment}
-         current_asmdata.asmlists[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
-         current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(classtable));
-         symtable.SymList.ForEachCall(@writefields,nil);
-
-         { generate the class table }
-         current_asmdata.asmlists[al_rtti].concat(tai_align.create(const_align(sizeof(aint))));
-         current_asmdata.asmlists[al_rtti].concat(Tai_label.Create(classtable));
-         current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(proptablelist.count));
-{$ifdef cpurequiresproperalignment}
-         current_asmdata.asmlists[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
-         hp:=tproptablelistitem(proptablelist.first);
-         while assigned(hp) do
-           begin
-              current_asmdata.asmlists[al_rtti].concat(Tai_const.Createname(tobjectdef(hp.def).vmt_mangledname,0));
-              hp:=tproptablelistitem(hp.next);
-           end;
-
-         generate_field_table:=fieldtable;
-         proptablelist.free;
-         proptablelist:=nil;
-      end;
-
-
-    procedure tobjectdef.write_rtti_data(rt:trttitype);
-
-        procedure collect_unique_published_props(pd:tobjectdef);
-        begin
-          if assigned(pd.childof) then
-            collect_unique_published_props(pd.childof);
-          pd.symtable.SymList.ForEachCall(@collect_published_properties,nil);
-        end;
-
-      var
-        i : longint;
-        propcount : longint;
-      begin
-         case objecttype of
-            odt_class:
-              current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkclass));
-            odt_object:
-              current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkobject));
-            odt_interfacecom:
-              current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkinterface));
-            odt_interfacecorba:
-              current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkinterfaceCorba));
-          else
-            exit;
-          end;
-
-         { generate the name }
-         current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(objrealname^)));
-         current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(objrealname^));
-{$ifdef cpurequiresproperalignment}
-         current_asmdata.asmlists[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
-         case rt of
-           initrtti :
-             begin
-               current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(size));
-               if objecttype in [odt_class,odt_object] then
-                begin
-                  count:=0;
-                  FRTTIType:=rt;
-                  symtable.SymList.ForEachCall(@count_field_rtti,nil);
-                  current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(count));
-                  symtable.SymList.ForEachCall(@write_field_rtti,nil);
-                end;
-             end;
-           fullrtti :
-             begin
-               { Collect unique property names with nameindex }
-               propnamelist:=TLinkedList.Create;
-               collect_unique_published_props(self);
-
-               if not(objecttype in [odt_interfacecom,odt_interfacecorba]) then
-                 begin
-                   if (oo_has_vmt in objectoptions) then
-                     current_asmdata.asmlists[al_rtti].concat(Tai_const.Createname(vmt_mangledname,0))
-                   else
-                     current_asmdata.asmlists[al_rtti].concat(Tai_const.create_sym(nil));
-                 end;
-
-               { write parent typeinfo }
-               if assigned(childof) and ((oo_can_have_published in childof.objectoptions) or
-                 (objecttype in [odt_interfacecom,odt_interfacecorba])) then
-                 current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(childof.get_rtti_label(fullrtti)))
-               else
-                 current_asmdata.asmlists[al_rtti].concat(Tai_const.create_sym(nil));
-
-               if objecttype in [odt_object,odt_class] then
-                 begin
-                   { total number of unique properties }
-                   current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(propnamelist.count));
-                 end
-               else
-                 { interface: write flags, iid and iidstr }
-                 begin
-                   current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(
-                     { ugly, but working }
-                     longint([
-                       TCompilerIntfFlag(ord(ifHasGuid)*ord(assigned(iidguid))),
-                       TCompilerIntfFlag(ord(ifHasStrGUID)*ord(assigned(iidstr)))
-                     ])
-                     {
-                     ifDispInterface,
-                     ifDispatch, }
-                     ));
-{$ifdef cpurequiresproperalignment}
-                   current_asmdata.asmlists[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
-                   current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(longint(iidguid^.D1)));
-                   current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(iidguid^.D2));
-                   current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(iidguid^.D3));
-                   for i:=Low(iidguid^.D4) to High(iidguid^.D4) do
-                     current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(iidguid^.D4[i]));
-                 end;
-
-               { write unit name }
-               current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(current_module.realmodulename^)));
-               current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(current_module.realmodulename^));
-
-{$ifdef cpurequiresproperalignment}
-               current_asmdata.asmlists[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
-
-               { write iidstr }
-               if objecttype in [odt_interfacecom,odt_interfacecorba] then
-                 begin
-                   if assigned(iidstr) then
-                     begin
-                       current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(iidstr^)));
-                       current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(iidstr^));
-                     end
-                   else
-                     current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(0));
-{$ifdef cpurequiresproperalignment}
-                   current_asmdata.asmlists[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
-                 end;
-
-               { write published properties for this object }
-               if objecttype in [odt_object,odt_class] then
-                 begin
-                   propcount:=0;
-                   symtable.SymList.ForEachCall(@count_published_properties,@propcount);
-                   current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(propcount));
-{$ifdef cpurequiresproperalignment}
-                   current_asmdata.asmlists[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
-                 end;
-               symtable.SymList.ForEachCall(@write_property_info,nil);
-
-               propnamelist.free;
-               propnamelist:=nil;
-             end;
-         end;
-      end;
-
-
     function tobjectdef.is_publishable : boolean;
       begin
          is_publishable:=objecttype in [odt_class,odt_interfacecom,odt_interfacecorba];

compiler/symsym.pas

@@ -327,21 +327,6 @@ interface
           function GetCopy:tmacro;
        end;
 
-       { compiler generated symbol to point to rtti and init/finalize tables }
-       trttisym = class(tstoredsym)
-       private
-          _mangledname : pshortstring;
-       public
-          lab     : tasmsymbol;
-          rttityp : trttitype;
-          constructor create(const n:string;rt:trttitype);
-          constructor ppuload(ppufile:tcompilerppufile);
-          destructor destroy;override;
-          procedure ppuwrite(ppufile:tcompilerppufile);override;
-          function  mangledname:string;override;
-          function  get_label:tasmsymbol;
-       end;
-
     var
        generrorsym : tsym;
 
@@ -2024,71 +2009,4 @@ implementation
         Result:=p;
       end;
 
-
-{****************************************************************************
-                                  TRTTISYM
-****************************************************************************}
-
-    constructor trttisym.create(const n:string;rt:trttitype);
-      const
-        prefix : array[trttitype] of string[5]=('$rtti','$init');
-      begin
-        inherited create(rttisym,prefix[rt]+n);
-        include(symoptions,sp_internal);
-        lab:=nil;
-        rttityp:=rt;
-      end;
-
-
-    destructor trttisym.destroy;
-      begin
-        if assigned(_mangledname) then
-          begin
-{$ifdef MEMDEBUG}
-            memmanglednames.start;
-{$endif MEMDEBUG}
-            stringdispose(_mangledname);
-{$ifdef MEMDEBUG}
-            memmanglednames.stop;
-{$endif MEMDEBUG}
-          end;
-        inherited destroy;
-      end;
-
-
-    constructor trttisym.ppuload(ppufile:tcompilerppufile);
-      begin
-        inherited ppuload(rttisym,ppufile);
-        lab:=nil;
-        rttityp:=trttitype(ppufile.getbyte);
-      end;
-
-
-    procedure trttisym.ppuwrite(ppufile:tcompilerppufile);
-      begin
-         inherited ppuwrite(ppufile);
-         ppufile.putbyte(byte(rttityp));
-         ppufile.writeentry(ibrttisym);
-      end;
-
-
-    function trttisym.mangledname : string;
-      const
-        prefix : array[trttitype] of string[5]=('RTTI_','INIT_');
-      begin
-        if not assigned(_mangledname) then
-          _mangledname:=stringdup(make_mangledname(prefix[rttityp],owner,Copy(name,5,255)));
-        result:=_mangledname^;
-      end;
-
-
-    function trttisym.get_label:tasmsymbol;
-      begin
-        { the label is always a global label }
-        if not assigned(lab) then
-         lab:=current_asmdata.RefAsmSymbol(mangledname);
-        get_label:=lab;
-      end;
-
-
 end.

compiler/symtable.pas

@@ -113,9 +113,12 @@ interface
           function  checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;override;
        end;
 
+       { tabstractlocalsymtable }
+
        tabstractlocalsymtable = class(tstoredsymtable)
        public
           procedure ppuwrite(ppufile:tcompilerppufile);override;
+          function count_locals:longint;
        end;
 
        tlocalsymtable = class(tabstractlocalsymtable)
@@ -180,7 +183,6 @@ interface
 ****************************************************************************}
 
 {*** Misc ***}
-    function  finduniTSymtable(st:TSymtable):TSymtable;
     function  FullTypeName(def,otherdef:tdef):string;
     procedure incompatibletypes(def1,def2:tdef);
     procedure hidesym(sym:TSymEntry);
@@ -363,7 +365,6 @@ implementation
                 ibunitsym : sym:=tunitsym.ppuload(ppufile);
                iblabelsym : sym:=tlabelsym.ppuload(ppufile);
                  ibsyssym : sym:=tsyssym.ppuload(ppufile);
-                ibrttisym : sym:=trttisym.ppuload(ppufile);
                ibmacrosym : sym:=tmacro.ppuload(ppufile);
                 ibendsyms : break;
                     ibend : Message(unit_f_ppu_read_error);
@@ -1085,6 +1086,25 @@ implementation
       end;
 
 
+    function tabstractlocalsymtable.count_locals:longint;
+      var
+        i   : longint;
+        sym : tsym;
+      begin
+        result:=0;
+        for i:=0 to SymList.Count-1 do
+          begin
+            sym:=tsym(SymList[i]);
+            { Count only varsyms, but ignore the funcretsym }
+            if (tsym(sym).typ in [localvarsym,paravarsym]) and
+               (tsym(sym)<>current_procinfo.procdef.funcretsym) and
+               (not(vo_is_parentfp in tabstractvarsym(sym).varoptions) or
+                (tstoredsym(sym).refs>0)) then
+              inc(result);
+         end;
+      end;
+
+
 {****************************************************************************
                               TLocalSymtable
 ****************************************************************************}
@@ -1375,33 +1395,6 @@ implementation
                              Helper Routines
 *****************************************************************************}
 
-    function finduniTSymtable(st:TSymtable):TSymtable;
-      begin
-        result:=nil;
-        repeat
-          if not assigned(st) then
-           internalerror(200602034);
-          case st.symtabletype of
-            localmacrosymtable,
-            exportedmacrosymtable,
-            staticsymtable,
-            globalsymtable :
-              begin
-                result:=st;
-                exit;
-              end;
-            recordsymtable,
-            localsymtable,
-            parasymtable,
-            ObjectSymtable :
-              st:=st.defowner.owner;
-            else
-              internalerror(200602035);
-          end;
-        until false;
-      end;
-
-
     function FullTypeName(def,otherdef:tdef):string;
       var
         s1,s2 : string;

compiler/symtype.pas

@@ -71,6 +71,7 @@ interface
          function  GetTypeName:string;virtual;
          function  mangledparaname:string;
          function  getmangledparaname:string;virtual;
+         function  rtti_mangledname(rt:trttitype):string;virtual;abstract;
          function  size:aint;virtual;abstract;
          function  packedbitsize:aint;virtual;
          function  alignment:shortint;virtual;abstract;
@@ -191,14 +192,46 @@ interface
     const
        current_object_option : tsymoptions = [sp_public];
 
+    function  FindUnitSymtable(st:TSymtable):TSymtable;
+    
 
 implementation
 
     uses
        verbose,
-       fmodule,symtable
+       fmodule
        ;
 
+{****************************************************************************
+                                Utils
+****************************************************************************}
+
+    function FindUnitSymtable(st:TSymtable):TSymtable;
+      begin
+        result:=nil;
+        repeat
+          if not assigned(st) then
+           internalerror(200602034);
+          case st.symtabletype of
+            localmacrosymtable,
+            exportedmacrosymtable,
+            staticsymtable,
+            globalsymtable :
+              begin
+                result:=st;
+                exit;
+              end;
+            recordsymtable,
+            localsymtable,
+            parasymtable,
+            ObjectSymtable :
+              st:=st.defowner.owner;
+            else
+              internalerror(200602035);
+          end;
+        until false;
+      end;
+
 
 {****************************************************************************
                                 Tdef
@@ -561,9 +594,9 @@ implementation
          begin
 {$warning TODO ugly hack}
            if s is tsym then
-             st:=finduniTSymtable(tsym(s).owner)
+             st:=FindUnitSymtable(tsym(s).owner)
            else
-             st:=finduniTSymtable(tdef(s).owner);
+             st:=FindUnitSymtable(tdef(s).owner);
            if not st.iscurrentunit then
              begin
                { register that the unit is needed for resolving }
@@ -968,3 +1001,4 @@ finalization
 {$endif MEMDEBUG}
 
 end.
+

compiler/symutil.pas

@@ -26,20 +26,17 @@ unit symutil;
 interface
 
     uses
-       symbase,symtype,symsym,cclasses;
+       symbase,symtype,symsym;
 
     function is_funcret_sym(p:TSymEntry):boolean;
 
-    { returns true, if sym needs an entry in the proplist of a class rtti }
-    function needs_prop_entry(sym : tsym) : boolean;
-
     function equal_constsym(sym1,sym2:tconstsym):boolean;
 
-    procedure count_locals(sym:TObject;arg:pointer);
 
 implementation
 
     uses
+       cclasses,
        globtype,cpuinfo,procinfo,
        symconst,widestr;
 
@@ -51,14 +48,6 @@ implementation
       end;
 
 
-    function needs_prop_entry(sym : tsym) : boolean;
-
-      begin
-         needs_prop_entry:=(sp_published in tsym(sym).symoptions) and
-         (sym.typ in [propertysym,fieldvarsym]);
-      end;
-
-
     function equal_constsym(sym1,sym2:tconstsym):boolean;
       var
         p1,p2,pend : pchar;
@@ -104,16 +93,5 @@ implementation
         end;
       end;
 
-
-    procedure count_locals(sym:TObject;arg:pointer);
-      begin
-        { Count only varsyms, but ignore the funcretsym }
-        if (tsym(sym).typ in [localvarsym,paravarsym]) and
-           (tsym(sym)<>current_procinfo.procdef.funcretsym) and
-           (not(vo_is_parentfp in tabstractvarsym(sym).varoptions) or
-            (tstoredsym(sym).refs>0)) then
-          inc(plongint(arg)^);
-      end;
-
-
 end.
+

compiler/utils/ppudump.pp

@@ -801,16 +801,6 @@ begin
   if df_unique in defoptions then
     writeln  (space,'      Unique type symbol');
 
-  if df_has_rttitable in defoptions then
-    begin
-      write  (space,'      RTTI symbol : ');
-      readderef;
-    end;
-  if df_has_inittable in defoptions then
-    begin
-      write  (space,'      Init symbol : ');
-      readderef;
-    end;
   if df_generic in defoptions then
     begin
       tokenbufsize:=ppufile.getlongint;
@@ -1572,12 +1562,6 @@ begin
              writeln(space,'  Internal Nr : ',getlongint);
            end;
 
-         ibrttisym :
-           begin
-             readcommonsym('RTTI symbol ');
-             writeln(space,'    RTTI Type : ',getbyte);
-           end;
-
          ibmacrosym :
            begin
              readcommonsym('Macro symbol ');