From ceccce93f512258d8656b56308fd1d8f991409e0 Mon Sep 17 00:00:00 2001 From: paul Date: Thu, 15 Apr 2010 07:37:41 +0000 Subject: [PATCH] compiler: add class constructors, class destructors to the initfinal table as regular initialization/finalization sections (class constructors is still not striped away with the class) git-svn-id: trunk@15143 - --- compiler/nflw.pas | 4 +- compiler/pdecobj.pas | 4 +- compiler/pmodules.pas | 95 +++++++++++++++++++++++++++++++------------ compiler/ppu.pas | 47 +++++++++++---------- compiler/psub.pas | 2 +- compiler/symdef.pas | 57 ++++++++++++++------------ 6 files changed, 130 insertions(+), 79 deletions(-) diff --git a/compiler/nflw.pas b/compiler/nflw.pas index 5f8599d482..afff8bf01e 100644 --- a/compiler/nflw.pas +++ b/compiler/nflw.pas @@ -556,7 +556,7 @@ begin if enumerator_is_class then begin { insert a try-finally and call the destructor for the enumerator in the finally section } - enumerator_destructor:=tobjectdef(enumerator_get.returndef).Finddestructor; + enumerator_destructor:=tobjectdef(enumerator_get.returndef).find_destructor; if assigned(enumerator_destructor) then begin whileloopnode:=ctryfinallynode.create( @@ -577,7 +577,7 @@ begin if is_object(enumerator_get.returndef) then begin // call the object destructor too - enumerator_destructor:=tobjectdef(enumerator_get.returndef).Finddestructor; + enumerator_destructor:=tobjectdef(enumerator_get.returndef).find_destructor; if assigned(enumerator_destructor) then begin addstatement(loopstatement, diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas index 4f2605550b..7f9d45eade 100644 --- a/compiler/pdecobj.pas +++ b/compiler/pdecobj.pas @@ -40,7 +40,7 @@ implementation symbase,symsym,symtable, node,nld,nmem,ncon,ncnv,ncal, fmodule,scanner, - pbase,pexpr,pdecsub,pdecvar,ptype,pdecl + pbase,pexpr,pdecsub,pdecvar,ptype,pdecl,ppu ; const @@ -68,6 +68,7 @@ implementation Message(parser_e_no_paras_for_class_constructor); consume(_SEMICOLON); include(current_objectdef.objectoptions,oo_has_class_constructor); + current_module.flags:=current_module.flags or uf_classinits; { no return value } pd.returndef:=voidtype; result:=pd; @@ -180,6 +181,7 @@ implementation Message(parser_e_no_paras_for_class_destructor); consume(_SEMICOLON); include(current_objectdef.objectoptions,oo_has_class_destructor); + current_module.flags:=current_module.flags or uf_classinits; { no return value } pd.returndef:=voidtype; result:=pd; diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas index 4a5d8a741d..ff54f56112 100644 --- a/compiler/pmodules.pas +++ b/compiler/pmodules.pas @@ -376,46 +376,89 @@ implementation ResourceStringTables.free; end; + procedure AddToClasInits(p:TObject;arg:pointer); + var + ClassList: TFPList absolute arg; + begin + if (tdef(p).typ=objectdef) and + ([oo_has_class_constructor,oo_has_class_destructor] * tobjectdef(p).objectoptions <> []) then + ClassList.Add(p); + end; procedure InsertInitFinalTable; var hp : tused_unit; unitinits : TAsmList; count : longint; + + procedure write_class_inits(u: tmodule); + var + i: integer; + classlist: TFPList; + pd: tprocdef; + begin + classlist := TFPList.Create; + if assigned(u.globalsymtable) then + u.globalsymtable.DefList.ForEachCall(@AddToClasInits,classlist); + u.localsymtable.DefList.ForEachCall(@AddToClasInits,classlist); + { write classes } + for i := 0 to classlist.Count - 1 do + begin + pd := tobjectdef(classlist[i]).find_procdef_bytype(potype_class_constructor); + if assigned(pd) then + unitinits.concat(Tai_const.Createname(pd.mangledname,0)) + else + unitinits.concat(Tai_const.Create_pint(0)); + pd := tobjectdef(classlist[i]).find_procdef_bytype(potype_class_destructor); + if assigned(pd) then + unitinits.concat(Tai_const.Createname(pd.mangledname,0)) + else + unitinits.concat(Tai_const.Create_pint(0)); + inc(count); + end; + classlist.free; + end; + begin unitinits:=TAsmList.Create; count:=0; hp:=tused_unit(usedunits.first); while assigned(hp) do begin + { insert class constructors/destructors of the unit } + if (hp.u.flags and uf_classinits) <> 0 then + write_class_inits(hp.u); { call the unit init code and make it external } if (hp.u.flags and (uf_init or uf_finalize))<>0 then - begin - if (hp.u.flags and uf_init)<>0 then - unitinits.concat(Tai_const.Createname(make_mangledname('INIT$',hp.u.globalsymtable,''),0)) - else - unitinits.concat(Tai_const.Create_sym(nil)); - if (hp.u.flags and uf_finalize)<>0 then - unitinits.concat(Tai_const.Createname(make_mangledname('FINALIZE$',hp.u.globalsymtable,''),0)) - else - unitinits.concat(Tai_const.Create_sym(nil)); - inc(count); - end; + begin + if (hp.u.flags and uf_init)<>0 then + unitinits.concat(Tai_const.Createname(make_mangledname('INIT$',hp.u.globalsymtable,''),0)) + else + unitinits.concat(Tai_const.Create_sym(nil)); + if (hp.u.flags and uf_finalize)<>0 then + unitinits.concat(Tai_const.Createname(make_mangledname('FINALIZE$',hp.u.globalsymtable,''),0)) + else + unitinits.concat(Tai_const.Create_sym(nil)); + inc(count); + end; hp:=tused_unit(hp.next); end; + { insert class constructors/destructor of the program } + if (current_module.flags and uf_classinits) <> 0 then + write_class_inits(current_module); { Insert initialization/finalization of the program } if (current_module.flags and (uf_init or uf_finalize))<>0 then - begin - if (current_module.flags and uf_init)<>0 then - unitinits.concat(Tai_const.Createname(make_mangledname('INIT$',current_module.localsymtable,''),0)) - else - unitinits.concat(Tai_const.Create_sym(nil)); - if (current_module.flags and uf_finalize)<>0 then - unitinits.concat(Tai_const.Createname(make_mangledname('FINALIZE$',current_module.localsymtable,''),0)) - else - unitinits.concat(Tai_const.Create_sym(nil)); - inc(count); - end; + begin + if (current_module.flags and uf_init)<>0 then + unitinits.concat(Tai_const.Createname(make_mangledname('INIT$',current_module.localsymtable,''),0)) + else + unitinits.concat(Tai_const.Create_sym(nil)); + if (current_module.flags and uf_finalize)<>0 then + unitinits.concat(Tai_const.Createname(make_mangledname('FINALIZE$',current_module.localsymtable,''),0)) + else + unitinits.concat(Tai_const.Create_sym(nil)); + inc(count); + end; { Insert TableCount,InitCount at start } unitinits.insert(Tai_const.Create_32bit(0)); unitinits.insert(Tai_const.Create_32bit(count)); @@ -429,7 +472,7 @@ implementation end; - procedure insertmemorysizes; + procedure InsertMemorySizes; {$IFDEF POWERPC} var stkcookie: string; @@ -1343,7 +1386,7 @@ implementation write_persistent_type_info(current_module.localsymtable); { Tables } - insertThreadVars; + InsertThreadvars; { Resource strings } GenerateResourceStrings; @@ -2329,11 +2372,11 @@ implementation InsertWideInits; { insert Tables and StackLength } - insertinitfinaltable; + InsertInitFinalTable; InsertThreadvarTablesTable; InsertResourceTablesTable; InsertWideInitsTablesTable; - insertmemorysizes; + InsertMemorySizes; { Insert symbol to resource info } InsertResourceInfo(resources_used); diff --git a/compiler/ppu.pas b/compiler/ppu.pas index 8c7ce0208d..0bc3acfe6d 100644 --- a/compiler/ppu.pas +++ b/compiler/ppu.pas @@ -135,30 +135,29 @@ const iblinkotherframeworks = 100; { unit flags } - uf_init = $1; - uf_finalize = $2; - uf_big_endian = $4; -// uf_has_browser = $10; - uf_in_library = $20; { is the file in another file than .* ? } - uf_smart_linked = $40; { the ppu can be smartlinked } - uf_static_linked = $80; { the ppu can be linked static } - uf_shared_linked = $100; { the ppu can be linked shared } -// uf_local_browser = $200; - uf_no_link = $400; { unit has no .o generated, but can still have - external linking! } - uf_has_resourcestrings = $800; { unit has resource string section } - uf_little_endian = $1000; - uf_release = $2000; { unit was compiled with -Ur option } - uf_threadvars = $4000; { unit has threadvars } - uf_fpu_emulation = $8000; { this unit was compiled with fpu emulation on } - uf_has_stabs_debuginfo = $10000; { this unit has stabs debuginfo generated } - uf_local_symtable = $20000; { this unit has a local symtable stored } - uf_uses_variants = $40000; { this unit uses variants } - uf_has_resourcefiles = $80000; { this unit has external resources (using $R directive)} - uf_has_exports = $100000; { this module or a used unit has exports } - uf_has_dwarf_debuginfo = $200000; { this unit has dwarf debuginfo generated } - uf_wideinits = $400000; { this unit has winlike widestring typed constants } - + uf_init = $000001; { unit has initialization section } + uf_finalize = $000002; { unit has finalization section } + uf_big_endian = $000004; +//uf_has_browser = $000010; + uf_in_library = $000020; { is the file in another file than .* ? } + uf_smart_linked = $000040; { the ppu can be smartlinked } + uf_static_linked = $000080; { the ppu can be linked static } + uf_shared_linked = $000100; { the ppu can be linked shared } +//uf_local_browser = $000200; + uf_no_link = $000400; { unit has no .o generated, but can still have external linking! } + uf_has_resourcestrings = $000800; { unit has resource string section } + uf_little_endian = $001000; + uf_release = $002000; { unit was compiled with -Ur option } + uf_threadvars = $004000; { unit has threadvars } + uf_fpu_emulation = $008000; { this unit was compiled with fpu emulation on } + uf_has_stabs_debuginfo = $010000; { this unit has stabs debuginfo generated } + uf_local_symtable = $020000; { this unit has a local symtable stored } + uf_uses_variants = $040000; { this unit uses variants } + uf_has_resourcefiles = $080000; { this unit has external resources (using $R directive)} + uf_has_exports = $100000; { this module or a used unit has exports } + uf_has_dwarf_debuginfo = $200000; { this unit has dwarf debuginfo generated } + uf_wideinits = $400000; { this unit has winlike widestring typed constants } + uf_classinits = $800000; { this unit has class constructors/destructors } type { bestreal is defined based on the target architecture } diff --git a/compiler/psub.pas b/compiler/psub.pas index 41719a0f23..cc37a93632 100644 --- a/compiler/psub.pas +++ b/compiler/psub.pas @@ -490,7 +490,7 @@ implementation { why (JM) } oldlocalswitches:=current_settings.localswitches; current_settings.localswitches:=oldlocalswitches-[cs_check_object,cs_check_range]; - pd:=current_objectdef.Finddestructor; + pd:=current_objectdef.find_destructor; if assigned(pd) then begin { if vmt<>0 then call destructor } diff --git a/compiler/symdef.pas b/compiler/symdef.pas index e5183b8ae4..79054aaee7 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -293,14 +293,15 @@ interface { this should be called when this class implements an interface } procedure prepareguid; function is_publishable : boolean;override; + function is_related(d : tdef) : boolean;override; function needs_inittable : boolean;override; function rtti_mangledname(rt:trttitype):string;override; function vmt_mangledname : string; procedure check_forwards; - function is_related(d : tdef) : boolean;override; procedure insertvmt; procedure set_parent(c : tobjectdef); - function FindDestructor : tprocdef; + function find_procdef_bytype(pt:tproctypeoption): tprocdef; + function find_destructor: tprocdef; function implements_any_interfaces: boolean; procedure reset; override; { dispinterface support } @@ -3299,7 +3300,8 @@ implementation if assigned(_class) then begin s:=_class.RttiName+'.'; - if (po_classmethod in procoptions) then + if (po_classmethod in procoptions) and + not (proctypeoption in [potype_class_constructor,potype_class_destructor]) then s:='class ' + s; end; if owner.symtabletype=localsymtable then @@ -3333,7 +3335,8 @@ implementation { forced calling convention? } if (po_hascallingconvention in procoptions) then s:=s+' '+ProcCallOptionStr[proccalloption]+';'; - if po_staticmethod in procoptions then + if (po_staticmethod in procoptions) and + not (proctypeoption in [potype_class_constructor,potype_class_destructor]) then s:=s+' Static;'; fullprocname:=s; end; @@ -4398,33 +4401,37 @@ implementation is_related:=false; end; - - function tobjectdef.FindDestructor : tprocdef; + function tobjectdef.find_procdef_bytype(pt:tproctypeoption): tprocdef; var - objdef : tobjectdef; - i : longint; - sym : tsym; - pd : tprocdef; + i: longint; + sym: tsym; + begin + for i:=0 to symtable.SymList.Count-1 do + begin + sym:=tsym(symtable.SymList[i]); + if sym.typ=procsym then + begin + result:=tprocsym(sym).find_procdef_bytype(pt); + if assigned(result) then + exit; + end; + end; + result:=nil; + end; + + function tobjectdef.find_destructor: tprocdef; + var + objdef: tobjectdef; begin - result:=nil; objdef:=self; while assigned(objdef) do begin - for i:=0 to objdef.symtable.SymList.Count-1 do - begin - sym:=TSym(objdef.symtable.SymList[i]); - if sym.typ=procsym then - begin - pd:=Tprocsym(sym).Find_procdef_bytype(potype_destructor); - if assigned(pd) then - begin - result:=pd; - exit; - end; - end; - end; - objdef:=objdef.childof; + result:=find_procdef_bytype(potype_destructor); + if assigned(result) then + exit; + objdef:=objdef.childof; end; + result:=nil; end; function tobjectdef.implements_any_interfaces: boolean;