paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-21 21:49:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

WPO: fix dead code detection, and handle procvars

Browse Source 
Extend dead code detection to not only look for the main mangled name, but also
for any aliases before deciding that a routine has been dead-stripped.

Assume objects/classes can also be constructed if the address of one of their
constructors or of the TObject.NewInstance class method has been taken.

Resolves #40204
This commit is contained in:
Jonas Maebe 2023-03-24 21:03:32 +01:00 committed by Pierre Muller
parent 002c7efa7a
commit 0594f9ae59
7 changed files with 128 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
compiler/ncal.pas
View File

@ -2539,21 +2539,6 @@ implementation
procedure tcallnode.register_created_object_types;
function checklive(def: tdef): boolean;
begin
if assigned(current_procinfo) and
not(po_inline in current_procinfo.procdef.procoptions) and
not wpoinfomanager.symbol_live(current_procinfo.procdef.mangledname) then
begin
{$ifdef debug_deadcode}
writeln(' NOT adding creadion of ',def.typename,' because performed in dead stripped proc: ',current_procinfo.procdef.typename);
{$endif debug_deadcode}
result:=false;
end
else
result:=true;
end;
var
crefdef,
systobjectdef : tdef;
@ -2572,16 +2557,12 @@ implementation
consider self-based newinstance calls, because then everything
will be assumed to be just a TObject since TObject.Create calls
NewInstance) }
if (procdefinition.proctypeoption=potype_constructor) or
((procdefinition.typ=procdef) and
((methodpointer.resultdef.typ=classrefdef) or
(methodpointer.nodetype=typen)) and
(tprocdef(procdefinition).procsym.Name='NEWINSTANCE')) then
if procdefinition.wpo_may_create_instance(methodpointer) then
begin
{ Only a typenode can be passed when it is called with <class of xx>.create }
if (methodpointer.nodetype=typen) then
begin
if checklive(methodpointer.resultdef) then
if wpoinfomanager.symbol_live_in_currentproc(methodpointer.resultdef) then
{ we know the exact class type being created }
tclassrefdef(methodpointer.resultdef).pointeddef.register_created_object_type
end
@ -2591,12 +2572,12 @@ implementation
if (methodpointer.nodetype=loadvmtaddrn) and
(tloadvmtaddrnode(methodpointer).left.nodetype=typen) then
begin
if checklive(methodpointer.resultdef) then
if wpoinfomanager.symbol_live_in_currentproc(methodpointer.resultdef) then
tclassrefdef(methodpointer.resultdef).pointeddef.register_created_object_type
end
else
begin
if checklive(methodpointer.resultdef) then
if wpoinfomanager.symbol_live_in_currentproc(methodpointer.resultdef) then
begin
{ special case: if the classref comes from x.classtype (with classtype,
being tobject.classtype) then the created instance is x or a descendant
@ -2638,7 +2619,7 @@ implementation
{ constructor with extended syntax called from new }
if (cnf_new_call in callnodeflags) then
begin
if checklive(methodpointer.resultdef) then
if wpoinfomanager.symbol_live_in_currentproc(methodpointer.resultdef) then
methodpointer.resultdef.register_created_object_type;
end
else
@ -2650,7 +2631,7 @@ implementation
if (procdefinition.proctypeoption=potype_constructor) then
begin
if (methodpointer.nodetype<>typen) and
checklive(methodpointer.resultdef) then
wpoinfomanager.symbol_live_in_currentproc(methodpointer.resultdef) then
methodpointer.resultdef.register_created_object_type;
end
end;

4
compiler/ngtcon.pas
View File

@ -208,9 +208,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
loadvmtaddrn:
begin
{ update wpo info }
if not assigned(current_procinfo) or
(po_inline in current_procinfo.procdef.procoptions) or
wpoinfomanager.symbol_live(current_procinfo.procdef.mangledname) then
if wpoinfomanager.symbol_live_in_currentproc(n.resultdef) then
tobjectdef(tclassrefdef(n.resultdef).pointeddef).register_maybe_created_object_type;
end;
else

16
compiler/nld.pas
View File

@ -198,7 +198,7 @@ implementation
htypechk,pass_1,procinfo,paramgr,
nbas,ncon,nflw,ninl,ncnv,nmem,ncal,nutils,
cgbase,
optloadmodifystore
optloadmodifystore,wpobase
;
@ -440,6 +440,20 @@ implementation
typecheckpass(left);
end
end;
{ we can't know what will happen with this function pointer, so
we have to assume it will be used to create an instance of this
type }
if fprocdef.wpo_may_create_instance(left) then
begin
if wpoinfomanager.symbol_live_in_currentproc(tdef(symtable.defowner)) then
begin
if assigned(left) then
tobjectdef(left.resultdef).register_created_object_type
else
tobjectdef(fprocdef.owner.defowner).register_created_object_type;
end;
end;
end;
labelsym:
begin

4
compiler/nmem.pas
View File

@ -276,9 +276,7 @@ implementation
not is_objcclassref(left.resultdef) then
begin
if not(nf_ignore_for_wpo in flags) and
(not assigned(current_procinfo) or
(po_inline in current_procinfo.procdef.procoptions) or
wpoinfomanager.symbol_live(current_procinfo.procdef.mangledname)) then
wpoinfomanager.symbol_live_in_currentproc(left.resultdef) then
begin
{ keep track of which classes might be instantiated via a classrefdef }
if (left.resultdef.typ=classrefdef) then

15
compiler/symdef.pas
View File

@ -728,6 +728,8 @@ interface
function generate_safecall_wrapper: boolean; virtual;
{ returns true if the def is a generic param of the procdef }
function is_generic_param(def:tdef): boolean;
function wpo_may_create_instance(optionalmethodpointer: tnode): boolean;
private
procedure count_para(p:TObject;arg:pointer);
procedure insert_para(p:TObject;arg:pointer);
@ -6148,6 +6150,19 @@ implementation
result:=false;
end;
function tabstractprocdef.wpo_may_create_instance(optionalmethodpointer: tnode): boolean;
begin
result:=
(proctypeoption=potype_constructor) or
((typ=procdef) and
((not assigned(optionalmethodpointer) and
is_class(tdef(owner.defowner))) or
(assigned(optionalmethodpointer) and
((optionalmethodpointer.resultdef.typ=classrefdef) or
(optionalmethodpointer.nodetype=typen)))) and
(tprocdef(self).procsym.Name='NEWINSTANCE'))
end;
{***************************************************************************
TPROCDEF

37
compiler/wpobase.pas
View File

@ -333,6 +333,8 @@ type
}
function symbol_live(const name: shortstring): boolean; virtual; abstract;
function symbol_live_in_currentproc(fordef: tdef): boolean;
constructor create; reintroduce;
destructor destroy; override;
end;
@ -347,7 +349,8 @@ implementation
globals,
cutils,
sysutils,
symdef,
symconst,symdef,
procinfo,
verbose;
@ -724,6 +727,38 @@ implementation
twpocomponentbaseclass(fwpocomponents[i]).checkoptions
end;
function twpoinfomanagerbase.symbol_live_in_currentproc(fordef: tdef): boolean;
function alias_symbol_live: boolean;
var
item: TCmdStrListItem;
begin
result:=true;
item:=TCmdStrListItem(current_procinfo.procdef.aliasnames.first);
while assigned(item) do
begin
if symbol_live(item.Str) then
exit;
item:=TCmdStrListItem(item.Next);
end;
result:=false;
end;
begin
if assigned(current_procinfo) and
not(po_inline in current_procinfo.procdef.procoptions) and
not symbol_live(current_procinfo.procdef.mangledname) and
not alias_symbol_live then
begin
{$ifdef debug_deadcode}
writeln(' NOT adding creation of ',fordef.typename,' because performed in dead stripped proc: ',current_procinfo.procdef.typename);
{$endif debug_deadcode}
result:=false;
end
else
result:=true;
end;
procedure twpoinfomanagerbase.extractwpoinfofromprogram;
var
i: longint;

54
tests/webtbs/tw40204.pp Normal file
View File

@ -0,0 +1,54 @@
{ %wpoparas=devirtcalls,optvmts }
{ %wpopasses=1 }
{$mode objfpc} {$longstrings on}
uses
Objects;
type
MyObjBase = object
constructor Create;
function GetVirt: string; virtual; abstract;
end;
MyObjA = object(MyObjBase)
constructor Create;
function GetVirt: string; virtual;
end;
MyObjB = object(MyObjBase)
constructor Create;
function GetVirt: string; virtual;
end;
constructor MyObjBase.Create; begin end;
constructor MyObjA.Create; begin end;
function MyObjA.GetVirt: string; begin result := 'MyObjA.GetVirt'; end;
constructor MyObjB.Create; begin end;
function MyObjB.GetVirt: string; begin result := 'MyObjB.GetVirt'; end;
type
MyObjFactory = record
ctr: CodePointer;
vmt: pointer;
end;
const
MyObjFactories: array[0 .. 1] of MyObjFactory =
(
(ctr: @MyObjA.Create; vmt: TypeOf(MyObjA)),
(ctr: @MyObjB.Create; vmt: TypeOf(MyObjB))
);
var
o: MyObjBase;
fact: MyObjFactory;
begin
for fact in MyObjFactories do
begin
CallVoidConstructor(fact.ctr, @o, fact.vmt);
writeln(o.GetVirt);
end;
end.