Parcourir la source

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 -
svenbarth il y a 9 ans
Parent
commit
f27ce0b159
7 fichiers modifiés avec 251 ajouts et 132 suppressions
  1. 2 0
      .gitattributes
  2. 7 0
      compiler/fmodule.pas
  3. 140 2
      compiler/pgenutil.pas
  4. 1 1
      compiler/pmodules.pas
  5. 18 129
      compiler/psub.pas
  6. 11 0
      tests/test/tgeneric102.pp
  7. 72 0
      tests/test/ugeneric102.pp

+ 2 - 0
.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

+ 7 - 0
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;

+ 140 - 2
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.

+ 1 - 1
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;
 
 

+ 18 - 129
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.

+ 11 - 0
tests/test/tgeneric102.pp

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

+ 72 - 0
tests/test/ugeneric102.pp

@@ -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.