1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273 |
- {
- 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,constexp,
- 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 write_rtti_extrasyms(def:Tdef;rt:Trttitype;mainrtti:Tasmsymbol);
- 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;
- function get_rtti_label_ord2str(def:tdef;rt:trttitype):tasmsymbol;
- function get_rtti_label_str2ord(def:tdef;rt:trttitype):tasmsymbol;
- end;
- var
- RTTIWriter : TRTTIWriter;
- implementation
- uses
- cutils,
- globals,globtype,verbose,systems,
- fmodule,
- symsym,
- aasmtai,aasmdata,
- defutil,
- wpobase
- ;
- const
- rttidefstate : array[trttitype] of tdefstate =
- (ds_rtti_table_written,ds_init_table_written,
- { Objective-C related, does not pass here }
- symconst.ds_none,symconst.ds_none,
- symconst.ds_none,symconst.ds_none);
- type
- TPropNameListItem = class(TFPHashObject)
- propindex : longint;
- propowner : TSymtable;
- end;
- {***************************************************************************
- TRTTIWriter
- ***************************************************************************}
- procedure TRTTIWriter.write_rtti_name(def:tdef);
- var
- hs : string;
- begin
- if is_open_array(def) then
- { open arrays never have a typesym with a name, since you cannot
- define an "open array type". Kylix prints the type of the
- elements in the array in this case (so together with the pfArray
- flag, you can reconstruct the full typename, I assume (JM))
- }
- def:=tarraydef(def).elementdef;
- { 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 (sym.visibility=vis_published) 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
- (sym.visibility=vis_published) 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
- (sym.visibility=vis_published) 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,space : 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) or
- is_object(def))) 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;
- {Hp.value is a Tconstexprint, which can be rather large,
- sanity check for longint overflow.}
- space:=(high(address)-address) div def.size;
- if int64(space)<hp^.value then
- internalerror(200706101);
- inc(address,int64(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)));
- { register for wpo }
- tprocdef(propaccesslist.procdef)._class.register_vmt_call(tprocdef(propaccesslist.procdef).extnumber);
- {$ifdef vtentry}
- { not sure if we can insert those vtentry symbols safely here }
- {$error register methods used for published properties}
- {$endif vtentry}
- 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
- (sym.visibility=vis_published) 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));
- if (tf_requires_proper_alignment in target_info.flags) then
- current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
- 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_unicodestring:
- begin
- current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkUString));
- 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));
- if (tf_requires_proper_alignment in target_info.flags) then
- current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
- end;
- end;
- end;
- procedure enumdef_rtti(def:tenumdef);
- var
- i : integer;
- hp : tenumsym;
- begin
- current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkEnumeration));
- write_rtti_name(def);
- if (tf_requires_proper_alignment in target_info.flags) then
- current_asmdata.asmlists[al_rtti].concat(Cai_align.Create(sizeof(TConstPtrUInt)));
- 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;
- if (tf_requires_proper_alignment in target_info.flags) then
- current_asmdata.asmlists[al_rtti].concat(Cai_align.Create(longint(def.size)));
- 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 (tf_requires_proper_alignment in target_info.flags) then
- current_asmdata.asmlists[al_rtti].concat(Cai_align.Create(sizeof(TConstPtrUint)));
- { write base type }
- 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));
- for i := 0 to def.symtable.SymList.Count - 1 do
- begin
- hp:=tenumsym(def.symtable.SymList[i]);
- if hp.value<def.minval then
- continue
- else
- if hp.value>def.maxval then
- break;
- current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(hp.realname)));
- current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(hp.realname));
- 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^));
- 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,otSByte,otSWord,otSLong,otSByte,
- otUByte,otUWord,otUByte);
- begin
- write_rtti_name(def);
- if (tf_requires_proper_alignment in target_info.flags) then
- current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
- current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(byte(trans[def.ordtype])));
- if (tf_requires_proper_alignment in target_info.flags) then
- current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
- {Convert to longint to smuggle values in high(longint)+1..high(cardinal) into asmlist.}
- current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(longint(def.low.svalue)));
- current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(longint(def.high.svalue)));
- end;
- begin
- case def.ordtype of
- s64bit :
- begin
- current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkInt64));
- write_rtti_name(def);
- if (tf_requires_proper_alignment in target_info.flags) then
- current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
- { low }
- current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_64bit(def.low.svalue));
- { high }
- current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_64bit(def.high.svalue));
- end;
- u64bit :
- begin
- current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkQWord));
- write_rtti_name(def);
- if (tf_requires_proper_alignment in target_info.flags) then
- current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
- {use svalue because Create_64bit accepts int64, prevents range checks}
- { low }
- current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_64bit(def.low.svalue));
- { high }
- current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_64bit(def.high.svalue));
- end;
- pasbool:
- 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;
- scurrency:
- begin
- current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkFloat));
- write_rtti_name(def);
- if (tf_requires_proper_alignment in target_info.flags) then
- current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
- current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(ftCurr));
- 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,sc80real,s64bit,s128bit);}
- translate : array[tfloattype] of byte =
- (ftSingle,ftDouble,ftExtended,ftExtended,ftComp,ftCurr,ftFloat128);
- begin
- current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkFloat));
- write_rtti_name(def);
- if (tf_requires_proper_alignment in target_info.flags) then
- current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
- 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);
- if (tf_requires_proper_alignment in target_info.flags) then
- current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
- case 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));
- else
- current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otUByte));
- end;
- if (tf_requires_proper_alignment in target_info.flags) then
- current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
- 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);
- if (tf_requires_proper_alignment in target_info.flags) then
- current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
- { size of elements }
- current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_pint(def.elesize));
- if not(ado_IsDynamicArray in def.arrayoptions) then
- begin
- current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_pint(pint(def.elecount)));
- { element type }
- current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.elementdef,rt)));
- end
- else
- { write a delphi almost compatible dyn. array entry:
- there are two types, eltype and eltype2, the latter is nil if the element type needs
- no finalization, the former is always valid, delphi has this swapped, but for
- compatibility with older fpc versions we do it different, to be delphi compatible,
- the names are swapped in typinfo.pp
- }
- begin
- { element type }
- current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.elementdef,rt)));
- end;
- { variant type }
- current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(tstoreddef(def.elementdef).getvardef));
- if ado_IsDynamicArray in def.arrayoptions then
- begin
- { element type }
- if def.elementdef.needs_inittable then
- current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.elementdef,rt)))
- else
- current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_pint(0));
- { 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^));
- end;
- 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);
- if (tf_requires_proper_alignment in target_info.flags) then
- current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
- 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 procvardef_rtti(def:tprocvardef);
- const
- ProcCallOptionToCallConv: array[tproccalloption] of byte = (
- { pocall_none } 0,
- { pocall_cdecl } 1,
- { pocall_cppdecl } 5,
- { pocall_far16 } 6,
- { pocall_oldfpccall } 7,
- { pocall_internproc } 8,
- { pocall_syscall } 9,
- { pocall_pascal } 2,
- { pocall_register } 0,
- { pocall_safecall } 4,
- { pocall_stdcall } 3,
- { pocall_softfloat } 10,
- { pocall_mwpascal } 11
- );
- 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;
- { Kylix also seems to always add both pfArray and pfReference
- in this case
- }
- if is_open_array(parasym.vardef) then
- paraspec:=paraspec or pfArray or pfReference;
- { and these for classes and interfaces (maybe because they
- are themselves addresses?)
- }
- if is_class_or_interface(parasym.vardef) then
- paraspec:=paraspec or pfAddress;
- { set bits run from the highest to the lowest bit on
- big endian systems
- }
- if (target_info.endian = endian_big) then
- paraspec:=reverse_byte(paraspec);
- { 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);
- if (tf_requires_proper_alignment in target_info.flags) then
- current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
- { write kind of method }
- case def.proctypeoption of
- potype_constructor: methodkind:=mkConstructor;
- potype_destructor: methodkind:=mkDestructor;
- potype_class_constructor: methodkind:=mkClassConstructor;
- potype_class_destructor: methodkind:=mkClassDestructor;
- potype_procedure:
- if po_classmethod in def.procoptions then
- methodkind:=mkClassProcedure
- else
- methodkind:=mkProcedure;
- potype_function:
- if po_classmethod in def.procoptions then
- methodkind:=mkClassFunction
- else
- methodkind:=mkFunction;
- else
- begin
- if def.returndef = voidtype then
- methodkind:=mkProcedure
- else
- methodkind:=mkFunction;
- end;
- end;
- 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));
- for i:=0 to def.paras.count-1 do
- write_para(tparavarsym(def.paras[i]));
- if (methodkind=mkFunction) or (methodkind=mkClassFunction) then
- begin
- { write name of result type }
- write_rtti_name(def.returndef);
- if (tf_requires_proper_alignment in target_info.flags) then
- current_asmdata.asmlists[al_rtti].concat(Cai_align.Create(sizeof(TConstPtrUint)));
- { write result typeinfo }
- current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.returndef,fullrtti)))
- end;
- { write calling convention }
- current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(ProcCallOptionToCallConv[def.proccalloption]));
- if (tf_requires_proper_alignment in target_info.flags) then
- current_asmdata.asmlists[al_rtti].concat(Cai_align.Create(sizeof(TConstPtrUint)));
- { write params typeinfo }
- for i:=0 to def.paras.count-1 do
- if not(vo_is_hidden_para in tparavarsym(def.paras[i]).varoptions) then
- current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(tparavarsym(def.paras[i]).vardef,fullrtti)));
- 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) 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^));
- if (tf_requires_proper_alignment in target_info.flags) then
- current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
- { write published properties for this object }
- current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(published_properties_count(def.symtable)));
- if (tf_requires_proper_alignment in target_info.flags) then
- current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
- published_properties_write_rtti_data(propnamelist,def.symtable);
- propnamelist.free;
- end;
- procedure objectdef_rtti_interface_full(def:tobjectdef);
- var
- i : longint;
- propnamelist : TFPHashObjectList;
- { if changed to a set, make sure it's still a byte large, and
- swap appropriately when cross-compiling
- }
- IntfFlags: byte;
- 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 }
- IntfFlags:=0;
- if assigned(def.iidguid) then
- IntfFlags:=IntfFlags or (1 shl ord(ifHasGuid));
- if assigned(def.iidstr) then
- IntfFlags:=IntfFlags or (1 shl ord(ifHasStrGUID));
- if (def.objecttype=odt_dispinterface) then
- IntfFlags:=IntfFlags or (1 shl ord(ifDispInterface));
- if (target_info.endian=endian_big) then
- IntfFlags:=reverse_byte(IntfFlags);
- {
- ifDispatch, }
- current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(IntfFlags));
- if (tf_requires_proper_alignment in target_info.flags) then
- current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
- 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^));
- if (tf_requires_proper_alignment in target_info.flags) then
- current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
- { 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));
- if (tf_requires_proper_alignment in target_info.flags) then
- current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
- { 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_dispinterface,
- 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^));
- if (tf_requires_proper_alignment in target_info.flags) then
- current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
- 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));
- procvardef :
- procvardef_rtti(tprocvardef(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_rtti_extrasyms(def:Tdef;rt:Trttitype;mainrtti:Tasmsymbol);
- procedure enumdef_rtti_ord2stringindex(def:Tenumdef);
- var rttilab:Tasmsymbol;
- t:Tenumsym;
- syms:^Tenumsym;
- offsets:^longint;
- sym_count,sym_alloc:longint;
- h,i,p,o,st:longint;
- mode:(lookup,search); {Modify with care, ordinal value of enum is written.}
- r:single; {Must be real type because of integer overflow risk.}
- begin
- {Random access needed, put in array.}
- getmem(syms,64*sizeof(Tenumsym));
- getmem(offsets,64*sizeof(longint));
- sym_count:=0;
- sym_alloc:=64;
- st:=0;
- for i := 0 to def.symtable.SymList.Count - 1 do
- begin
- t:=tenumsym(def.symtable.SymList[i]);
- if t.value<def.minval then
- continue
- else
- if t.value>def.maxval then
- break;
- if sym_count>=sym_alloc then
- begin
- reallocmem(syms,2*sym_alloc*sizeof(Tenumsym));
- reallocmem(offsets,2*sym_alloc*sizeof(longint));
- sym_alloc:=sym_alloc*2;
- end;
- syms[sym_count]:=t;
- offsets[sym_count]:=st;
- inc(sym_count);
- st:=st+length(t.realname)+1;
- end;
- {Sort the syms by enum value}
- if sym_count>=2 then
- begin
- p:=1;
- while 2*p<sym_count do
- p:=2*p;
- while p<>0 do
- begin
- for h:=p to sym_count-1 do
- begin
- i:=h;
- t:=syms[i];
- o:=offsets[i];
- repeat
- if syms[i-p].value<=t.value then
- break;
- syms[i]:=syms[i-p];
- offsets[i]:=offsets[i-p];
- dec(i,p);
- until i<p;
- syms[i]:=t;
- offsets[i]:=o;
- end;
- p:=p shr 1;
- end;
- end;
- {Decide wether a lookup array is size efficient.}
- mode:=lookup;
- if sym_count>0 then
- begin
- i:=1;
- r:=0;
- h:=syms[0].value; {Next expected enum value is min.}
- while i<sym_count do
- begin
- {Calculate size of hole between values. Avoid integer overflows.}
- r:=r+(single(syms[i].value)-single(h))-1;
- h:=syms[i].value;
- inc(i);
- end;
- if r>sym_count then
- mode:=search; {Don't waste more than 50% space.}
- end;
- {Calculate start of string table.}
- st:=1;
- if assigned(def.typesym) then
- inc(st,length(def.typesym.realname)+1)
- else
- inc(st);
- if (tf_requires_proper_alignment in target_info.flags) then
- st:=align(st,sizeof(Tconstptruint));
- inc(st);
- if (tf_requires_proper_alignment in target_info.flags) then
- st:=align(st,sizeof(Tconstptruint));
- inc(st,8+sizeof(pint));
- { write rtti data }
- with current_asmdata do
- begin
- rttilab:=defineasmsymbol(Tstoreddef(def).rtti_mangledname(rt)+'_o2s',AB_GLOBAL,AT_DATA);
- maybe_new_object_file(asmlists[al_rtti]);
- new_section(asmlists[al_rtti],sec_rodata,rttilab.name,const_align(sizeof(pint)));
- asmlists[al_rtti].concat(Tai_symbol.create_global(rttilab,0));
- asmlists[al_rtti].concat(Tai_const.create_32bit(longint(mode)));
- if mode=lookup then
- begin
- if (tf_requires_proper_alignment in target_info.flags) then
- current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
- o:=syms[0].value; {Start with min value.}
- for i:=0 to sym_count-1 do
- begin
- while o<syms[i].value do
- begin
- asmlists[al_rtti].concat(Tai_const.create_pint(0));
- inc(o);
- end;
- inc(o);
- asmlists[al_rtti].concat(Tai_const.create_sym_offset(mainrtti,st+offsets[i]));
- end;
- end
- else
- begin
- asmlists[al_rtti].concat(Tai_const.create_32bit(sym_count));
- for i:=0 to sym_count-1 do
- begin
- if (tf_requires_proper_alignment in target_info.flags) then
- current_asmdata.asmlists[al_rtti].concat(cai_align.Create(4));
- asmlists[al_rtti].concat(Tai_const.create_32bit(syms[i].value));
- if (tf_requires_proper_alignment in target_info.flags) then
- current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
- asmlists[al_rtti].concat(Tai_const.create_sym_offset(mainrtti,st+offsets[i]));
- end;
- end;
- asmlists[al_rtti].concat(Tai_symbol_end.create(rttilab));
- end;
- freemem(syms);
- freemem(offsets);
- end;
- procedure enumdef_rtti_string2ordindex(def:Tenumdef);
- var rttilab:Tasmsymbol;
- t:Tenumsym;
- syms:^Tenumsym;
- offsets:^longint;
- sym_count,sym_alloc:longint;
- h,i,p,o,st:longint;
- begin
- {Random access needed, put in array.}
- getmem(syms,64*sizeof(Tenumsym));
- getmem(offsets,64*sizeof(longint));
- sym_count:=0;
- sym_alloc:=64;
- st:=0;
- for i := 0 to def.symtable.SymList.Count - 1 do
- begin
- t:=tenumsym(def.symtable.SymList[i]);
- if t.value<def.minval then
- continue
- else
- if t.value>def.maxval then
- break;
- if sym_count>=sym_alloc then
- begin
- reallocmem(syms,2*sym_alloc*sizeof(Tenumsym));
- reallocmem(offsets,2*sym_alloc*sizeof(longint));
- sym_alloc:=sym_alloc*2;
- end;
- syms[sym_count]:=t;
- offsets[sym_count]:=st;
- inc(sym_count);
- st:=st+length(t.realname)+1;
- end;
- {Sort the syms by enum name}
- if sym_count>=2 then
- begin
- p:=1;
- while 2*p<sym_count do
- p:=2*p;
- while p<>0 do
- begin
- for h:=p to sym_count-1 do
- begin
- i:=h;
- t:=syms[i];
- o:=offsets[i];
- repeat
- if syms[i-p].name<=t.name then
- break;
- syms[i]:=syms[i-p];
- offsets[i]:=offsets[i-p];
- dec(i,p);
- until i<p;
- syms[i]:=t;
- offsets[i]:=o;
- end;
- p:=p shr 1;
- end;
- end;
- {Calculate start of string table.}
- st:=1;
- if assigned(def.typesym) then
- inc(st,length(def.typesym.realname)+1)
- else
- inc(st);
- if (tf_requires_proper_alignment in target_info.flags) then
- st:=align(st,sizeof(Tconstptruint));
- inc(st);
- if (tf_requires_proper_alignment in target_info.flags) then
- st:=align(st,sizeof(Tconstptruint));
- inc(st,8+sizeof(pint));
- { write rtti data }
- with current_asmdata do
- begin
- rttilab:=defineasmsymbol(Tstoreddef(def).rtti_mangledname(rt)+'_s2o',AB_GLOBAL,AT_DATA);
- maybe_new_object_file(asmlists[al_rtti]);
- new_section(asmlists[al_rtti],sec_rodata,rttilab.name,const_align(sizeof(pint)));
- asmlists[al_rtti].concat(Tai_symbol.create_global(rttilab,0));
- asmlists[al_rtti].concat(Tai_const.create_32bit(sym_count));
- for i:=0 to sym_count-1 do
- begin
- if (tf_requires_proper_alignment in target_info.flags) then
- current_asmdata.asmlists[al_rtti].concat(cai_align.Create(4));
- asmlists[al_rtti].concat(Tai_const.create_32bit(syms[i].value));
- if (tf_requires_proper_alignment in target_info.flags) then
- current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
- asmlists[al_rtti].concat(Tai_const.create_sym_offset(mainrtti,st+offsets[i]));
- end;
- asmlists[al_rtti].concat(Tai_symbol_end.create(rttilab));
- end;
- freemem(syms);
- freemem(offsets);
- end;
- begin
- case def.typ of
- enumdef:
- if rt=fullrtti then
- begin
- enumdef_rtti_ord2stringindex(Tenumdef(def));
- enumdef_rtti_string2ordindex(Tenumdef(def));
- end;
- 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 :
- begin
- if assigned(tobjectdef(def).childof) then
- write_rtti(tobjectdef(def).childof,rt);
- if rt=initrtti then
- fields_write_rtti(tobjectdef(def).symtable,rt)
- else
- published_write_rtti(tobjectdef(def).symtable,rt);
- end;
- end;
- end;
- function TRTTIWriter.ref_rtti(def:tdef;rt:trttitype):tasmsymbol;
- begin
- result:=current_asmdata.RefAsmSymbol(def.rtti_mangledname(rt));
- end;
- procedure TRTTIWriter.write_rtti(def:tdef;rt:trttitype);
- var
- rttilab : tasmsymbol;
- begin
- { only write rtti of definitions from the current module }
- if not findunitsymtable(def.owner).iscurrentunit then
- exit;
- { prevent recursion }
- if rttidefstate[rt] in def.defstates then
- exit;
- include(def.defstates,rttidefstate[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(pint)));
- current_asmdata.asmlists[al_rtti].concat(Tai_symbol.Create_global(rttilab,0));
- write_rtti_data(def,rt);
- current_asmdata.asmlists[al_rtti].concat(Tai_symbol_end.Create(rttilab));
- write_rtti_extrasyms(def,rt,rttilab);
- end;
- function TRTTIWriter.get_rtti_label(def:tdef;rt:trttitype):tasmsymbol;
- begin
- result:=current_asmdata.RefAsmSymbol(def.rtti_mangledname(rt));
- end;
- function TRTTIWriter.get_rtti_label_ord2str(def:tdef;rt:trttitype):tasmsymbol;
- begin
- result:=current_asmdata.RefAsmSymbol(def.rtti_mangledname(rt)+'_o2s');
- end;
- function TRTTIWriter.get_rtti_label_str2ord(def:tdef;rt:trttitype):tasmsymbol;
- begin
- result:=current_asmdata.RefAsmSymbol(def.rtti_mangledname(rt)+'_s2o');
- end;
- end.
|