diff options
author | peter <peter@3ad0048d-3df7-0310-abae-a5850022a9f2> | 2006-11-04 10:43:27 +0000 |
---|---|---|
committer | peter <peter@3ad0048d-3df7-0310-abae-a5850022a9f2> | 2006-11-04 10:43:27 +0000 |
commit | 56e79c634b1868697ea0b585d452f7442beab31f (patch) | |
tree | 63ab2d86073ab06dba89348bdfe7324ceb0a6e23 | |
parent | 8fcebb524c3f785a3fe1ae728320187645cf528b (diff) | |
download | fpc-56e79c634b1868697ea0b585d452f7442beab31f.tar.gz |
* moved rtti to ncgrtti
git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@5219 3ad0048d-3df7-0310-abae-a5850022a9f2
-rw-r--r-- | compiler/cgobj.pas | 13 | ||||
-rw-r--r-- | compiler/dbgdwarf.pas | 3 | ||||
-rw-r--r-- | compiler/ncginl.pas | 4 | ||||
-rw-r--r-- | compiler/ncgld.pas | 4 | ||||
-rw-r--r-- | compiler/ncgrtti.pas | 880 | ||||
-rw-r--r-- | compiler/ncgutil.pas | 79 | ||||
-rw-r--r-- | compiler/nobj.pas | 84 | ||||
-rw-r--r-- | compiler/parser.pas | 7 | ||||
-rw-r--r-- | compiler/pdecl.pas | 54 | ||||
-rw-r--r-- | compiler/powerpc/cpupi.pas | 7 | ||||
-rw-r--r-- | compiler/powerpc64/cpupi.pas | 7 | ||||
-rw-r--r-- | compiler/ppu.pas | 4 | ||||
-rw-r--r-- | compiler/pstatmnt.pas | 5 | ||||
-rw-r--r-- | compiler/psystem.pas | 25 | ||||
-rw-r--r-- | compiler/symconst.pas | 4 | ||||
-rw-r--r-- | compiler/symdef.pas | 956 | ||||
-rw-r--r-- | compiler/symsym.pas | 82 | ||||
-rw-r--r-- | compiler/symtable.pas | 51 | ||||
-rw-r--r-- | compiler/symtype.pas | 40 | ||||
-rw-r--r-- | compiler/symutil.pas | 28 | ||||
-rw-r--r-- | compiler/utils/ppudump.pp | 16 |
21 files changed, 1111 insertions, 1242 deletions
diff --git a/compiler/cgobj.pas b/compiler/cgobj.pas index 2d5cd4cad6..d7fd2894ba 100644 --- a/compiler/cgobj.pas +++ b/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); diff --git a/compiler/dbgdwarf.pas b/compiler/dbgdwarf.pas index 4b5a8431da..413b36fcff 100644 --- a/compiler/dbgdwarf.pas +++ b/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 } ; diff --git a/compiler/ncginl.pas b/compiler/ncginl.pas index 41ba87f39e..3c4f3a8dc2 100644 --- a/compiler/ncginl.pas +++ b/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; diff --git a/compiler/ncgld.pas b/compiler/ncgld.pas index 97da075635..86213d1ffe 100644 --- a/compiler/ncgld.pas +++ b/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; diff --git a/compiler/ncgrtti.pas b/compiler/ncgrtti.pas new file mode 100644 index 0000000000..24e34a5211 --- /dev/null +++ b/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. + diff --git a/compiler/ncgutil.pas b/compiler/ncgutil.pas index 041121d572..83d48c8838 100644 --- a/compiler/ncgutil.pas +++ b/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; diff --git a/compiler/nobj.pas b/compiler/nobj.pas index 93099e5049..4f658ad917 100644 --- a/compiler/nobj.pas +++ b/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 } diff --git a/compiler/parser.pas b/compiler/parser.pas index 3de47585f4..249d3497fb 100644 --- a/compiler/parser.pas +++ b/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; diff --git a/compiler/pdecl.pas b/compiler/pdecl.pas index 86baa8a34c..51169719aa 100644 --- a/compiler/pdecl.pas +++ b/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; diff --git a/compiler/powerpc/cpupi.pas b/compiler/powerpc/cpupi.pas index 49ab468df2..837c293a70 100644 --- a/compiler/powerpc/cpupi.pas +++ b/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); diff --git a/compiler/powerpc64/cpupi.pas b/compiler/powerpc64/cpupi.pas index 278d6f5940..4f24d14aea 100644 --- a/compiler/powerpc64/cpupi.pas +++ b/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; diff --git a/compiler/ppu.pas b/compiler/ppu.pas index debe265ac7..a398229856 100644 --- a/compiler/ppu.pas +++ b/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; diff --git a/compiler/pstatmnt.pas b/compiler/pstatmnt.pas index 95a694fba7..624eb1014a 100644 --- a/compiler/pstatmnt.pas +++ b/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 diff --git a/compiler/psystem.pas b/compiler/psystem.pas index 2a176306fe..c6cb3473b5 100644 --- a/compiler/psystem.pas +++ b/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); diff --git a/compiler/symconst.pas b/compiler/symconst.pas index f2b821a0fd..8b5e15e346 100644 --- a/compiler/symconst.pas +++ b/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] = ( diff --git a/compiler/symdef.pas b/compiler/symdef.pas index 031d429308..25f58e8029 100644 --- a/compiler/symdef.pas +++ b/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]; diff --git a/compiler/symsym.pas b/compiler/symsym.pas index a04e65ba63..7284803707 100644 --- a/compiler/symsym.pas +++ b/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. diff --git a/compiler/symtable.pas b/compiler/symtable.pas index be8546c748..703f41f981 100644 --- a/compiler/symtable.pas +++ b/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; diff --git a/compiler/symtype.pas b/compiler/symtype.pas index 3b8e874042..75161b4ef3 100644 --- a/compiler/symtype.pas +++ b/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. + diff --git a/compiler/symutil.pas b/compiler/symutil.pas index 488b47bde8..f8e5f6b9fa 100644 --- a/compiler/symutil.pas +++ b/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. + diff --git a/compiler/utils/ppudump.pp b/compiler/utils/ppudump.pp index 0fc368004b..7fef859325 100644 --- a/compiler/utils/ppudump.pp +++ b/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 '); |