Rework the way the method bodies for specializations are generated: instead of walking the global and local symboltable all pending specializations are kept in a list of the current module which is (for now) walked at the end of a unit/program to generate the method bodies as before.

fmodule.pas, tmodule:
  + new list pendingspecializations which keeps track of all pending specializations of the current module
psub.pas:
  * move generate_specialization_procs and related routines to pgenutil
  + new procedure read_proc_body to read a routine's body, cause generate_specialization_procs needs it (unlike the already existing overload in the implementation section, this one can only handle bodies of non-nested routines) 
pgenutil.pas:
  * generate_specialization_phase2: add the newly specialized generic to the current module's pending specializations
  * generate_specialization_procs: reworked so that it uses the new pendingspecializations field instead of walking the global and local symboltable of the current unit
pmodules.pas:
  + add pgenutil to uses due to the moved generate_specialization_procs

+ added test

git-svn-id: trunk@33826 -
This commit is contained in:
svenbarth 2016-05-26 18:56:16 +00:00
parent 2f6a1c01ba
commit f27ce0b159
7 changed files with 251 additions and 132 deletions

2
.gitattributes vendored
View File

@ -12294,6 +12294,7 @@ tests/test/tgeneric1.pp svneol=native#text/plain
tests/test/tgeneric10.pp svneol=native#text/plain
tests/test/tgeneric100.pp svneol=native#text/pascal
tests/test/tgeneric101.pp svneol=native#text/pascal
tests/test/tgeneric102.pp svneol=native#text/pascal
tests/test/tgeneric11.pp svneol=native#text/plain
tests/test/tgeneric12.pp svneol=native#text/plain
tests/test/tgeneric13.pp svneol=native#text/plain
@ -13043,6 +13044,7 @@ tests/test/uenum2b.pp svneol=native#text/plain
tests/test/ugenconstraints.pas svneol=native#text/pascal
tests/test/ugeneric.test75.pp svneol=native#text/pascal
tests/test/ugeneric10.pp svneol=native#text/plain
tests/test/ugeneric102.pp svneol=native#text/pascal
tests/test/ugeneric14.pp svneol=native#text/plain
tests/test/ugeneric3.pp svneol=native#text/plain
tests/test/ugeneric4.pp svneol=native#text/plain

View File

@ -195,6 +195,9 @@ interface
non-generic typename and the data is a TFPObjectList of tgenericdummyentry
instances whereby the last one is the current top most one }
genericdummysyms: TFPHashObjectList;
{ contains a list of specializations for which the method bodies need
to be generated }
pendingspecializations : TFPHashObjectList;
{ this contains a list of units that needs to be waited for until the
unit can be finished (code generated, etc.); this is needed to handle
@ -585,6 +588,7 @@ implementation
checkforwarddefs:=TFPObjectList.Create(false);
extendeddefs:=TFPHashObjectList.Create(true);
genericdummysyms:=tfphashobjectlist.create(true);
pendingspecializations:=tfphashobjectlist.create(false);
waitingforunit:=tfpobjectlist.create(false);
waitingunits:=tfpobjectlist.create(false);
globalsymtable:=nil;
@ -677,6 +681,7 @@ implementation
FImportLibraryList.Free;
extendeddefs.Free;
genericdummysyms.free;
pendingspecializations.free;
waitingforunit.free;
waitingunits.free;
stringdispose(asmprefix);
@ -808,6 +813,8 @@ implementation
dependent_units:=TLinkedList.Create;
resourcefiles.Free;
resourcefiles:=TCmdStrList.Create;
pendingspecializations.free;
pendingspecializations:=tfphashobjectlist.create(false);
linkunitofiles.Free;
linkunitofiles:=TLinkContainer.Create;
linkunitstaticlibs.Free;

View File

@ -51,6 +51,8 @@ uses
function resolve_generic_dummysym(const name:tidstring):tsym;
function could_be_generic(const name:tidstring):boolean;inline;
procedure generate_specialization_procs;
procedure specialization_init(genericdef:tdef;var state:tspecializationstate);
procedure specialization_done(var state:tspecializationstate);
@ -70,7 +72,7 @@ uses
node,nobj,nmem,
{ parser }
scanner,
pbase,pexpr,pdecsub,ptype;
pbase,pexpr,pdecsub,ptype,psub;
procedure maybe_add_waiting_unit(tt:tdef);
@ -1071,7 +1073,9 @@ uses
specialization_done(state);
if not assigned(result.owner) then
result.changeowner(specializest);
result.ChangeOwner(specializest);
current_module.pendingspecializations.add(result.typename,result);
end;
generictypelist.free;
@ -1506,4 +1510,138 @@ uses
fillchar(state, sizeof(state), 0);
end;
{****************************************************************************
SPECIALIZATION BODY GENERATION
****************************************************************************}
procedure process_procdef(def:tprocdef;hmodule:tmodule);
var
oldcurrent_filepos : tfileposinfo;
begin
if assigned(def.genericdef) and
(def.genericdef.typ=procdef) and
assigned(tprocdef(def.genericdef).generictokenbuf) then
begin
if not assigned(tprocdef(def.genericdef).generictokenbuf) then
internalerror(2015061902);
oldcurrent_filepos:=current_filepos;
current_filepos:=tprocdef(def.genericdef).fileinfo;
{ use the index the module got from the current compilation process }
current_filepos.moduleindex:=hmodule.unit_index;
current_tokenpos:=current_filepos;
current_scanner.startreplaytokens(tprocdef(def.genericdef).generictokenbuf);
read_proc_body(def);
current_filepos:=oldcurrent_filepos;
end
{ synthetic routines will be implemented afterwards }
else if def.synthetickind=tsk_none then
MessagePos1(def.fileinfo,sym_e_forward_not_resolved,def.fullprocname(false));
end;
function process_abstractrecorddef(def:tabstractrecorddef):boolean;
var
i : longint;
hp : tdef;
hmodule : tmodule;
begin
result:=true;
hmodule:=find_module_from_symtable(def.genericdef.owner);
if hmodule=nil then
internalerror(201202041);
for i:=0 to def.symtable.DefList.Count-1 do
begin
hp:=tdef(def.symtable.DefList[i]);
if hp.typ=procdef then
begin
{ only generate the code if we need a body }
if assigned(tprocdef(hp).struct) and not tprocdef(hp).forwarddef then
continue;
{ and the body is available already }
if tprocdef(tprocdef(hp).genericdef).forwarddef then
begin
result:=false;
continue;
end;
process_procdef(tprocdef(hp),hmodule);
end
else
if hp.typ in [objectdef,recorddef] then
{ generate code for subtypes as well }
result:=process_abstractrecorddef(tabstractrecorddef(hp)) and result;
end;
end;
procedure generate_specialization_procs;
var
i : longint;
list,
readdlist : tfpobjectlist;
def : tstoreddef;
state : tspecializationstate;
hmodule : tmodule;
begin
{ first copy all entries and then work with that list to ensure that
we don't get an infinite recursion }
list:=tfpobjectlist.create(false);
readdlist:=tfpobjectlist.create(false);
for i:=0 to current_module.pendingspecializations.Count-1 do
list.add(current_module.pendingspecializations.Items[i]);
current_module.pendingspecializations.clear;
for i:=0 to list.count-1 do
begin
def:=tstoreddef(list[i]);
if not tstoreddef(def).is_specialization then
continue;
case def.typ of
procdef:
begin
if not tprocdef(def).forwarddef then
continue;
if not assigned(def.genericdef) then
internalerror(2015061903);
if tprocdef(def.genericdef).forwarddef then
begin
readdlist.add(def);
continue;
end;
hmodule:=find_module_from_symtable(def.genericdef.owner);
if hmodule=nil then
internalerror(2015061904);
specialization_init(tstoreddef(def).genericdef,state);
process_procdef(tprocdef(def),hmodule);
specialization_done(state);
end;
recorddef,
objectdef:
begin
specialization_init(tstoreddef(def).genericdef,state);
if not process_abstractrecorddef(tabstractrecorddef(def)) then
readdlist.add(def);
specialization_done(state);
end;
end;
end;
{ add those defs back to the pending list for which we don't yet have
all method bodies }
for i:=0 to readdlist.count-1 do
current_module.pendingspecializations.add(tstoreddef(readdlist[i]).typename,readdlist[i]);
readdlist.free;
list.free;
end;
end.

View File

@ -47,7 +47,7 @@ implementation
objcgutl,
pkgutil,
wpobase,
scanner,pbase,pexpr,psystem,psub,pdecsub,ncgvmt,ncgrtti,
scanner,pbase,pexpr,psystem,psub,pdecsub,pgenutil,ncgvmt,ncgrtti,
cpuinfo;

View File

@ -85,9 +85,10 @@ interface
true) }
procedure read_proc(isclassmethod:boolean; usefwpd: tprocdef;isgeneric:boolean);
procedure import_external_proc(pd:tprocdef);
{ parses only the body of a non nested routine; needs a correctly setup pd }
procedure read_proc_body(pd:tprocdef);inline;
procedure generate_specialization_procs;
procedure import_external_proc(pd:tprocdef);
implementation
@ -2051,6 +2052,21 @@ implementation
end;
procedure read_proc_body(pd:tprocdef);
var
old_module_procinfo : tobject;
old_current_procinfo : tprocinfo;
begin
old_current_procinfo:=current_procinfo;
old_module_procinfo:=current_module.procinfo;
current_procinfo:=nil;
current_module.procinfo:=nil;
read_proc_body(nil,pd);
current_procinfo:=old_current_procinfo;
current_module.procinfo:=old_module_procinfo;
end;
procedure read_proc(isclassmethod:boolean; usefwpd: tprocdef;isgeneric:boolean);
{
Parses the procedure directives, then parses the procedure body, then
@ -2498,131 +2514,4 @@ implementation
end;
{****************************************************************************
SPECIALIZATION BODY GENERATION
****************************************************************************}
procedure specialize_objectdefs(p:TObject;arg:pointer);
var
specobj : tabstractrecorddef;
state : tspecializationstate;
procedure process_procdef(def:tprocdef;hmodule:tmodule);
var
oldcurrent_filepos : tfileposinfo;
begin
if assigned(def.genericdef) and
(def.genericdef.typ=procdef) and
assigned(tprocdef(def.genericdef).generictokenbuf) then
begin
if not assigned(tprocdef(def.genericdef).generictokenbuf) then
internalerror(2015061902);
oldcurrent_filepos:=current_filepos;
current_filepos:=tprocdef(def.genericdef).fileinfo;
{ use the index the module got from the current compilation process }
current_filepos.moduleindex:=hmodule.unit_index;
current_tokenpos:=current_filepos;
current_scanner.startreplaytokens(tprocdef(def.genericdef).generictokenbuf);
read_proc_body(nil,def);
current_filepos:=oldcurrent_filepos;
end
{ synthetic routines will be implemented afterwards }
else if def.synthetickind=tsk_none then
MessagePos1(def.fileinfo,sym_e_forward_not_resolved,def.fullprocname(false));
end;
procedure process_abstractrecorddef(def:tabstractrecorddef);
var
i : longint;
hp : tdef;
hmodule : tmodule;
begin
hmodule:=find_module_from_symtable(def.genericdef.owner);
if hmodule=nil then
internalerror(201202041);
for i:=0 to def.symtable.DefList.Count-1 do
begin
hp:=tdef(def.symtable.DefList[i]);
if hp.typ=procdef then
begin
{ only generate the code if we need a body }
if assigned(tprocdef(hp).struct) and not tprocdef(hp).forwarddef then
continue;
process_procdef(tprocdef(hp),hmodule);
end
else
if hp.typ in [objectdef,recorddef] then
{ generate code for subtypes as well }
process_abstractrecorddef(tabstractrecorddef(hp));
end;
end;
procedure process_procsym(procsym:tprocsym);
var
i : longint;
pd : tprocdef;
state : tspecializationstate;
hmodule : tmodule;
begin
for i:=0 to procsym.procdeflist.count-1 do
begin
pd:=tprocdef(procsym.procdeflist[i]);
if not pd.is_specialization then
continue;
if not pd.forwarddef then
continue;
if not assigned(pd.genericdef) then
internalerror(2015061903);
hmodule:=find_module_from_symtable(pd.genericdef.owner);
if hmodule=nil then
internalerror(2015061904);
specialization_init(pd.genericdef,state);
process_procdef(pd,hmodule);
specialization_done(state);
end;
end;
begin
if not((tsym(p).typ=typesym) and
(ttypesym(p).typedef.typesym=tsym(p)) and
(ttypesym(p).typedef.typ in [objectdef,recorddef])
) and
not (tsym(p).typ=procsym) then
exit;
if tsym(p).typ=procsym then
process_procsym(tprocsym(p))
else
if df_specialization in ttypesym(p).typedef.defoptions then
begin
{ Setup symtablestack a definition time }
specobj:=tabstractrecorddef(ttypesym(p).typedef);
if not (is_class_or_object(specobj) or is_record(specobj) or is_javaclass(specobj)) then
exit;
specialization_init(specobj.genericdef,state);
{ procedure definitions for classes or objects }
process_abstractrecorddef(specobj);
specialization_done(state);
end
else
tabstractrecorddef(ttypesym(p).typedef).symtable.symlist.whileeachcall(@specialize_objectdefs,nil);
end;
procedure generate_specialization_procs;
begin
if assigned(current_module.globalsymtable) then
current_module.globalsymtable.SymList.WhileEachCall(@specialize_objectdefs,nil);
if assigned(current_module.localsymtable) then
current_module.localsymtable.SymList.WhileEachCall(@specialize_objectdefs,nil);
end;
end.

11
tests/test/tgeneric102.pp Normal file
View File

@ -0,0 +1,11 @@
{ %NORUN }
program tgeneric102;
uses
ugeneric102;
begin
Test;
Test2;
end.

72
tests/test/ugeneric102.pp Normal file
View File

@ -0,0 +1,72 @@
unit ugeneric102;
{$mode objfpc}{$H+}
interface
type
generic TTest<T> = class
class function Test(aTest: T): T; inline;
class function Test2(aTest: T): T; inline;
end;
TTestLongInt = specialize TTest<LongInt>;
generic function TestFunc<T>(aTest: T): T; inline;
procedure Test;
procedure Test2;
implementation
class function TTest.Test(aTest: T): T;
begin
Result := aTest;
end;
type
TTestBoolean = specialize TTest<Boolean>;
{ here the functions won't be inlined, cause the bodies are missing }
procedure Test;
begin
Writeln(TTestLongInt.Test(42));
Writeln(TTestBoolean.Test(True));
Writeln(specialize TTest<String>.Test('Hello World'));
Writeln(TTestLongInt.Test2(42));
Writeln(TTestBoolean.Test2(True));
Writeln(specialize TTest<String>.Test2('Hello World'));
Writeln(specialize TestFunc<LongInt>(42));
Writeln(specialize TestFunc<Boolean>(True));
Writeln(specialize TestFunc<String>('Hello World'));
end;
class function TTest.Test2(aTest: T): T;
begin
Result := aTest;
end;
generic function TestFunc<T>(aTest: T): T;
begin
Result := aTest;
end;
{ here the functions will be inlined as now the bodies are available }
procedure Test2;
begin
Writeln(TTestLongInt.Test(42));
Writeln(TTestBoolean.Test(True));
Writeln(specialize TTest<String>.Test('Hello World'));
Writeln(TTestLongInt.Test2(42));
Writeln(TTestBoolean.Test2(True));
Writeln(specialize TTest<String>.Test2('Hello World'));
Writeln(specialize TestFunc<LongInt>(42));
Writeln(specialize TestFunc<Boolean>(True));
Writeln(specialize TestFunc<String>('Hello World'));
end;
end.