From f27ce0b159dcca492bdbecf990559c8a8c9fc6e2 Mon Sep 17 00:00:00 2001 From: svenbarth Date: Thu, 26 May 2016 18:56:16 +0000 Subject: [PATCH] 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 - --- .gitattributes | 2 + compiler/fmodule.pas | 7 ++ compiler/pgenutil.pas | 142 +++++++++++++++++++++++++++++++++++- compiler/pmodules.pas | 2 +- compiler/psub.pas | 147 +++++--------------------------------- tests/test/tgeneric102.pp | 11 +++ tests/test/ugeneric102.pp | 72 +++++++++++++++++++ 7 files changed, 251 insertions(+), 132 deletions(-) create mode 100644 tests/test/tgeneric102.pp create mode 100644 tests/test/ugeneric102.pp diff --git a/.gitattributes b/.gitattributes index 8734d703a8..cbf00ee4ca 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/compiler/fmodule.pas b/compiler/fmodule.pas index 687318736d..32d7a2c22f 100644 --- a/compiler/fmodule.pas +++ b/compiler/fmodule.pas @@ -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; diff --git a/compiler/pgenutil.pas b/compiler/pgenutil.pas index 7509870248..1d672deecc 100644 --- a/compiler/pgenutil.pas +++ b/compiler/pgenutil.pas @@ -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. diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas index c0f18cf9d5..e6b7f69fa5 100644 --- a/compiler/pmodules.pas +++ b/compiler/pmodules.pas @@ -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; diff --git a/compiler/psub.pas b/compiler/psub.pas index 3bbb09b387..5b3562e233 100644 --- a/compiler/psub.pas +++ b/compiler/psub.pas @@ -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. diff --git a/tests/test/tgeneric102.pp b/tests/test/tgeneric102.pp new file mode 100644 index 0000000000..6d30559fa8 --- /dev/null +++ b/tests/test/tgeneric102.pp @@ -0,0 +1,11 @@ +{ %NORUN } + +program tgeneric102; + +uses + ugeneric102; + +begin + Test; + Test2; +end. diff --git a/tests/test/ugeneric102.pp b/tests/test/ugeneric102.pp new file mode 100644 index 0000000000..dfdc491ab5 --- /dev/null +++ b/tests/test/ugeneric102.pp @@ -0,0 +1,72 @@ +unit ugeneric102; + +{$mode objfpc}{$H+} + +interface + +type + generic TTest = class + class function Test(aTest: T): T; inline; + class function Test2(aTest: T): T; inline; + end; + + TTestLongInt = specialize TTest; + +generic function TestFunc(aTest: T): T; inline; + +procedure Test; +procedure Test2; + +implementation + +class function TTest.Test(aTest: T): T; +begin + Result := aTest; +end; + +type + TTestBoolean = specialize TTest; + +{ 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.Test('Hello World')); + + Writeln(TTestLongInt.Test2(42)); + Writeln(TTestBoolean.Test2(True)); + Writeln(specialize TTest.Test2('Hello World')); + + Writeln(specialize TestFunc(42)); + Writeln(specialize TestFunc(True)); + Writeln(specialize TestFunc('Hello World')); +end; + +class function TTest.Test2(aTest: T): T; +begin + Result := aTest; +end; + +generic function TestFunc(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.Test('Hello World')); + + Writeln(TTestLongInt.Test2(42)); + Writeln(TTestBoolean.Test2(True)); + Writeln(specialize TTest.Test2('Hello World')); + + Writeln(specialize TestFunc(42)); + Writeln(specialize TestFunc(True)); + Writeln(specialize TestFunc('Hello World')); +end; + +end.