paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-22 13:31:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Add finalization of typed consts

Browse Source 
* Finalization of globals in the main program
This commit is contained in:
peter 2002-10-06 19:41:30 +00:00
parent ba37c177c5
commit 6d4fcce014
3 changed files with 92 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
compiler/ncgutil.pas
View File

@ -971,18 +971,31 @@ implementation
list : taasmoutput;
begin
list:=taasmoutput(arg);
if (tsym(p).typ=varsym) and
not(vo_is_local_copy in tvarsym(p).varoptions) and
assigned(tvarsym(p).vartype.def) and
not(is_class(tvarsym(p).vartype.def)) and
tvarsym(p).vartype.def.needs_inittable then
begin
if tsym(p).owner.symtabletype in [localsymtable,inlinelocalsymtable] then
reference_reset_base(href,procinfo.framepointer,-tvarsym(p).address+tvarsym(p).owner.address_fixup)
else
reference_reset_symbol(href,objectlibrary.newasmsymbol(tvarsym(p).mangledname),0);
cg.g_finalize(list,tvarsym(p).vartype.def,href,false);
end;
case tsym(p).typ of
varsym :
begin
if not(vo_is_local_copy in tvarsym(p).varoptions) and
assigned(tvarsym(p).vartype.def) and
not(is_class(tvarsym(p).vartype.def)) and
tvarsym(p).vartype.def.needs_inittable then
begin
if tsym(p).owner.symtabletype in [localsymtable,inlinelocalsymtable] then
reference_reset_base(href,procinfo.framepointer,-tvarsym(p).address+tvarsym(p).owner.address_fixup)
else
reference_reset_symbol(href,objectlibrary.newasmsymbol(tvarsym(p).mangledname),0);
cg.g_finalize(list,tvarsym(p).vartype.def,href,false);
end;
end;
typedconstsym :
begin
if ttypedconstsym(p).is_writable and
ttypedconstsym(p).typedconsttype.def.needs_inittable then
begin
reference_reset_symbol(href,objectlibrary.newasmsymbol(ttypedconstsym(p).mangledname),0);
cg.g_finalize(list,ttypedconstsym(p).typedconsttype.def,href,false);
end;
end;
end;
end;
@ -1295,6 +1308,8 @@ implementation
end;
{ units have seperate code for initilization and finalization }
potype_unitfinalize: ;
{ program init/final is generated in separate procedure }
potype_proginit: ;
else
aktprocdef.localst.foreach_static({$ifndef TP}@{$endif}initialize_data,list);
end;
@ -1537,8 +1552,10 @@ implementation
tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}finalize_data,list);
tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}finalize_data,list);
end;
{ units have seperate code for initialization and finalization }
{ units/progs have separate code for initialization and finalization }
potype_unitinit: ;
{ program init/final is generated in separate procedure }
potype_proginit: ;
else
aktprocdef.localst.foreach_static({$ifndef TP}@{$endif}finalize_data,list);
end;
@ -1827,7 +1844,8 @@ implementation
list.concat(Tai_symbol.Createname_global(target_info.cprefix+current_module.modulename^+'_init',0));
{ using current_module.globalsymtable is hopefully }
{ more robust than symtablestack and symtablestack.next }
tsymtable(current_module.globalsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
if assigned(current_module.globalsymtable) then
tsymtable(current_module.globalsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
tsymtable(current_module.localsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
cg.g_return_from_proc(list,0);
end;
@ -1844,7 +1862,8 @@ implementation
list.concat(Tai_symbol.Createname_global(target_info.cprefix+current_module.modulename^+'_finalize',0));
{ using current_module.globalsymtable is hopefully }
{ more robust than symtablestack and symtablestack.next }
tsymtable(current_module.globalsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
if assigned(current_module.globalsymtable) then
tsymtable(current_module.globalsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
tsymtable(current_module.localsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
cg.g_return_from_proc(list,0);
end;
@ -1854,7 +1873,11 @@ implementation
end.
{
$Log$
Revision 1.53 2002-10-05 15:18:42 carl
Revision 1.54 2002-10-06 19:41:30 peter
* Add finalization of typed consts
* Finalization of globals in the main program
Revision 1.53 2002/10/05 15:18:42 carl
* fix heap leaks
Revision 1.52 2002/09/30 07:00:46 florian

44
compiler/pmodules.pas
View File

@ -212,9 +212,6 @@ implementation
end;
procedure InsertInitFinalTable;
var
hp : tused_unit;
@ -241,14 +238,19 @@ implementation
end;
hp:=tused_unit(hp.next);
end;
if current_module.islibrary then
if (current_module.flags and uf_finalize)<>0 then
begin
{ INIT code is done by PASCALMAIN calling }
unitinits.concat(Tai_const.Create_32bit(0));
unitinits.concat(Tai_const_symbol.Createname('FINALIZE$$'+current_module.modulename^));
inc(count);
end;
{ 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_symbol.Createname('INIT$$'+current_module.modulename^))
else
unitinits.concat(Tai_const.Create_32bit(0));
if (current_module.flags and uf_finalize)<>0 then
unitinits.concat(Tai_const_symbol.Createname('FINALIZE$$'+current_module.modulename^))
else
unitinits.concat(Tai_const.Create_32bit(0));
inc(count);
end;
{ TableCount,InitCount }
unitinits.insert(Tai_const.Create_32bit(0));
unitinits.insert(Tai_const.Create_32bit(count));
@ -1262,6 +1264,20 @@ implementation
insertLocalThreadvarsTablesTable;
compile_proc_body(true,false);
{ should we force unit initialization? }
if tstaticsymtable(current_module.localsymtable).needs_init_final then
begin
current_module.flags:=current_module.flags or (uf_init or uf_finalize);
{ Add initialize section }
if (cs_create_smart in aktmoduleswitches) then
codeSegment.concat(Tai_cut.Create);
genimplicitunitinit(codesegment);
{ Add finalize section }
if (cs_create_smart in aktmoduleswitches) then
codeSegment.concat(Tai_cut.Create);
genimplicitunitfinal(codesegment);
end;
{ Add symbol to the exports section for win32 so smartlinking a
DLL will include the edata section }
if assigned(exportlib) and
@ -1388,7 +1404,11 @@ implementation
end.
{
$Log$
Revision 1.79 2002-09-09 17:34:15 peter
Revision 1.80 2002-10-06 19:41:30 peter
* Add finalization of typed consts
* Finalization of globals in the main program
Revision 1.79 2002/09/09 17:34:15 peter
* tdicationary.replace added to replace and item in a dictionary. This
is only allowed for the same name
* varsyms are inserted in symtable before the types are parsed. This

28
compiler/symtable.pas
View File

@ -932,12 +932,22 @@ implementation
procedure TStoredSymtable._needs_init_final(p : tnamedindexitem;arg:pointer);
begin
if (not b_needs_init_final) and
(tsym(p).typ=varsym) and
assigned(tvarsym(p).vartype.def) and
not is_class(tvarsym(p).vartype.def) and
tstoreddef(tvarsym(p).vartype.def).needs_inittable then
b_needs_init_final:=true;
if b_needs_init_final then
exit;
case tsym(p).typ of
varsym :
begin
if not(is_class(tvarsym(p).vartype.def)) and
tstoreddef(tvarsym(p).vartype.def).needs_inittable then
b_needs_init_final:=true;
end;
typedconstsym :
begin
if ttypedconstsym(p).is_writable and
tstoreddef(ttypedconstsym(p).typedconsttype.def).needs_inittable then
b_needs_init_final:=true;
end;
end;
end;
@ -2311,7 +2321,11 @@ implementation
end.
{
$Log$
Revision 1.73 2002-10-05 12:43:29 carl
Revision 1.74 2002-10-06 19:41:31 peter
* Add finalization of typed consts
* Finalization of globals in the main program
Revision 1.73 2002/10/05 12:43:29 carl
* fixes for Delphi 6 compilation
(warning : Some features do not work under Delphi)