Browse Source

Implement generation of method bodies for generic functions.

psub.pas, specialize_objectdefs:
  + new nested procedure process_procdef() to handle the generation of method bodies for procdefs both in generic types as well as of generic functions
  + new nested procedure process_procsym() to handle the generation of method bodies for each specialization procdef of a procsym
  * allow all procsyms and recursively walk all non-generic types to find all method bodies that need to be generated

git-svn-id: trunk@32383 -
svenbarth 9 years ago
parent
commit
3c41e50f2f
1 changed files with 72 additions and 27 deletions
  1. 72 27
      compiler/psub.pas

+ 72 - 27
compiler/psub.pas

@@ -2483,6 +2483,30 @@ implementation
         specobj : tabstractrecorddef;
         specobj : tabstractrecorddef;
         state : tspecializationstate;
         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);
       procedure process_abstractrecorddef(def:tabstractrecorddef);
         var
         var
           i  : longint;
           i  : longint;
@@ -2500,22 +2524,7 @@ implementation
                  { only generate the code if we need a body }
                  { only generate the code if we need a body }
                  if assigned(tprocdef(hp).struct) and not tprocdef(hp).forwarddef then
                  if assigned(tprocdef(hp).struct) and not tprocdef(hp).forwarddef then
                    continue;
                    continue;
-                 if assigned(tprocdef(hp).genericdef) and
-                   (tprocdef(hp).genericdef.typ=procdef) and
-                   assigned(tprocdef(tprocdef(hp).genericdef).generictokenbuf) then
-                   begin
-                     oldcurrent_filepos:=current_filepos;
-                     current_filepos:=tprocdef(tprocdef(hp).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(tprocdef(hp).genericdef).generictokenbuf);
-                     read_proc_body(nil,tprocdef(hp));
-                     current_filepos:=oldcurrent_filepos;
-                   end
-                 { synthetic routines will be implemented afterwards }
-                 else if tprocdef(hp).synthetickind=tsk_none then
-                   MessagePos1(tprocdef(hp).fileinfo,sym_e_forward_not_resolved,tprocdef(hp).fullprocname(false));
+                 process_procdef(tprocdef(hp),hmodule);
                end
                end
              else
              else
                if hp.typ in [objectdef,recorddef] then
                if hp.typ in [objectdef,recorddef] then
@@ -2524,26 +2533,62 @@ implementation
            end;
            end;
         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
       begin
         if not((tsym(p).typ=typesym) and
         if not((tsym(p).typ=typesym) and
                (ttypesym(p).typedef.typesym=tsym(p)) and
                (ttypesym(p).typedef.typesym=tsym(p)) and
-               (ttypesym(p).typedef.typ in [objectdef,recorddef]) and
-               (df_specialization in ttypesym(p).typedef.defoptions)
-              ) then
+               (ttypesym(p).typedef.typ in [objectdef,recorddef])
+              ) and
+            not (tsym(p).typ=procsym) then
           exit;
           exit;
 
 
-        { Setup symtablestack a definition time }
-        specobj:=tabstractrecorddef(ttypesym(p).typedef);
+        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;
+              if not (is_class_or_object(specobj) or is_record(specobj) or is_javaclass(specobj)) then
+                exit;
 
 
-        specialization_init(specobj.genericdef,state);
+              specialization_init(specobj.genericdef,state);
 
 
-        { procedure definitions for classes or objects }
-        process_abstractrecorddef(specobj);
+              { procedure definitions for classes or objects }
+              process_abstractrecorddef(specobj);
 
 
-        specialization_done(state);
+              specialization_done(state);
+            end
+          else
+            tabstractrecorddef(ttypesym(p).typedef).symtable.symlist.whileeachcall(@specialize_objectdefs,nil);
       end;
       end;