* Move the setup and teardown of the specialization symtable stack into two extra

  procedures, so that changes in the setup/teardown need to be done only once 
  instead of twice.

git-svn-id: trunk@20246 -

compiler/pgenutil.pas

@@ -30,12 +30,21 @@ uses
   { common }
   cclasses,
   { symtable }
-  symtype,symdef;
+  symtype,symdef,symbase;
 
     procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;_prettyname:string;parsedtype:tdef;symname:string);
     function parse_generic_parameters:TFPObjectList;
     procedure insert_generic_parameter_types(def:tstoreddef;genericdef:tstoreddef;genericlist:TFPObjectList);
 
+    type
+      tspecializationstate = record
+        oldsymtablestack   : tsymtablestack;
+        oldextendeddefs    : TFPHashObjectList;
+      end;
+
+    procedure specialization_init(genericdef:tdef;var state:tspecializationstate);
+    procedure specialization_done(var state:tspecializationstate);
+
 implementation
 
 uses
@@ -44,7 +53,7 @@ uses
   { global }
   globals,globtype,tokens,verbose,
   { symtable }
-  symconst,symbase,symsym,symtable,
+  symconst,symsym,symtable,
   { modules }
   fmodule,
   { pass 1 }
@@ -69,10 +78,6 @@ uses
         generictype : ttypesym;
         genericdeflist : TFPObjectList;
         generictypelist : TFPObjectList;
-        oldsymtablestack   : tsymtablestack;
-        oldextendeddefs    : TFPHashObjectList;
-        hmodule : tmodule;
-        pu : tused_unit;
         prettyname,specializename : ansistring;
         ufinalspecializename,
         countstr,genname,ugenname,finalspecializename : string;
@@ -84,7 +89,7 @@ uses
         tempst : tglobalsymtable;
         old_block_type: tblock_type;
         hashedid: thashedidstring;
-        unitsyms : tfphashobjectlist;
+        state : tspecializationstate;
       begin
         { retrieve generic def that we are going to replace }
         genericdef:=tstoreddef(tt);
@@ -335,47 +340,7 @@ uses
 
         if not assigned(tt) then
           begin
-            { Setup symtablestack at definition time
-              to get types right, however this is not perfect, we should probably record
-              the resolved symbols }
-            oldsymtablestack:=symtablestack;
-            oldextendeddefs:=current_module.extendeddefs;
-            current_module.extendeddefs:=TFPHashObjectList.create(true);
-            symtablestack:=tdefawaresymtablestack.create;
-            if not assigned(genericdef) then
-              internalerror(200705151);
-            hmodule:=find_module_from_symtable(genericdef.owner);
-            if hmodule=nil then
-              internalerror(200705152);
-            { collect all unit syms in the generic's unit as we need to establish
-              their unitsym.module link again so that unit identifiers can be used }
-            unitsyms:=tfphashobjectlist.create(false);
-            if (hmodule<>current_module) and assigned(hmodule.globalsymtable) then
-              for i:=0 to hmodule.globalsymtable.symlist.count-1 do
-                begin
-                  srsym:=tsym(hmodule.globalsymtable.symlist[i]);
-                  if srsym.typ=unitsym then
-                    unitsyms.add(upper(srsym.realname),srsym);
-                end;
-            pu:=tused_unit(hmodule.used_units.first);
-            while assigned(pu) do
-              begin
-                if not assigned(pu.u.globalsymtable) then
-                  internalerror(200705153);
-                symtablestack.push(pu.u.globalsymtable);
-                srsym:=tsym(unitsyms.find(pu.u.modulename^));
-                if assigned(srsym) and not assigned(tunitsym(srsym).module) then
-                  tunitsym(srsym).module:=pu.u;
-                pu:=tused_unit(pu.next);
-              end;
-            unitsyms.free;
-
-            if assigned(hmodule.globalsymtable) then
-              symtablestack.push(hmodule.globalsymtable);
-
-            { push the localsymtable if needed }
-            if (hmodule<>current_module) or not current_module.in_interface then
-              symtablestack.push(hmodule.localsymtable);
+            specialization_init(genericdef,state);
 
             { push a temporary global symtable so that the specialization is
               added to the correct symtable; this symtable does not contain
@@ -499,11 +464,7 @@ uses
 
             tempst.free;
 
-            { Restore symtablestack }
-            current_module.extendeddefs.free;
-            current_module.extendeddefs:=oldextendeddefs;
-            symtablestack.free;
-            symtablestack:=oldsymtablestack;
+            specialization_done(state);
           end;
 
         if not (token in [_GT, _RSHARPBRACKET]) then
@@ -571,4 +532,65 @@ uses
           end;
        end;
 
+    procedure specialization_init(genericdef:tdef;var state: tspecializationstate);
+    var
+      pu : tused_unit;
+      hmodule : tmodule;
+      unitsyms : TFPHashObjectList;
+      sym : tsym;
+      i : Integer;
+    begin
+      if not assigned(genericdef) then
+        internalerror(200705151);
+      { Setup symtablestack at definition time
+        to get types right, however this is not perfect, we should probably record
+        the resolved symbols }
+      state.oldsymtablestack:=symtablestack;
+      state.oldextendeddefs:=current_module.extendeddefs;
+      current_module.extendeddefs:=TFPHashObjectList.create(true);
+      symtablestack:=tdefawaresymtablestack.create;
+      hmodule:=find_module_from_symtable(genericdef.owner);
+      if hmodule=nil then
+        internalerror(200705152);
+      { collect all unit syms in the generic's unit as we need to establish
+        their unitsym.module link again so that unit identifiers can be used }
+      unitsyms:=tfphashobjectlist.create(false);
+      if (hmodule<>current_module) and assigned(hmodule.globalsymtable) then
+        for i:=0 to hmodule.globalsymtable.symlist.count-1 do
+          begin
+            sym:=tsym(hmodule.globalsymtable.symlist[i]);
+            if sym.typ=unitsym then
+              unitsyms.add(upper(sym.realname),sym);
+          end;
+      { add all interface units to the new symtable stack }
+      pu:=tused_unit(hmodule.used_units.first);
+      while assigned(pu) do
+        begin
+          if not assigned(pu.u.globalsymtable) then
+            internalerror(200705153);
+          symtablestack.push(pu.u.globalsymtable);
+          sym:=tsym(unitsyms.find(pu.u.modulename^));
+          if assigned(sym) and not assigned(tunitsym(sym).module) then
+            tunitsym(sym).module:=pu.u;
+          pu:=tused_unit(pu.next);
+        end;
+      unitsyms.free;
+      if assigned(hmodule.globalsymtable) then
+        symtablestack.push(hmodule.globalsymtable);
+      { push the localsymtable if needed }
+      if (hmodule<>current_module) or not current_module.in_interface then
+        symtablestack.push(hmodule.localsymtable);
+    end;
+
+    procedure specialization_done(var state: tspecializationstate);
+    begin
+      { Restore symtablestack }
+      current_module.extendeddefs.free;
+      current_module.extendeddefs:=state.oldextendeddefs;
+      symtablestack.free;
+      symtablestack:=state.oldsymtablestack;
+      { clear the state record to be on the safe side }
+      fillchar(state, sizeof(state), 0);
+    end;
+
 end.

compiler/psub.pas

@@ -99,7 +99,7 @@ implementation
 {$endif}
        { parser }
        scanner,import,gendef,
-       pbase,pstatmnt,pdecl,pdecsub,pexports,
+       pbase,pstatmnt,pdecl,pdecsub,pexports,pgenutil,
        { codegen }
        tgobj,cgbase,cgobj,cgcpu,dbgbase,
        ncgutil,regvars,
@@ -1972,20 +1972,18 @@ implementation
     procedure specialize_objectdefs(p:TObject;arg:pointer);
       var
         oldcurrent_filepos : tfileposinfo;
-        oldsymtablestack   : tsymtablestack;
-        oldextendeddefs    : TFPHashObjectList;
-        pu : tused_unit;
-        hmodule : tmodule;
         specobj : tabstractrecorddef;
-        unitsyms : TFPHashObjectList;
-        sym : tsym;
-        i : Integer;
+        state : tspecializationstate;
 
       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]);
@@ -2032,50 +2030,12 @@ implementation
         if not (is_class_or_object(specobj) or is_record(specobj)) then
           exit;
 
-        oldsymtablestack:=symtablestack;
-        oldextendeddefs:=current_module.extendeddefs;
-        current_module.extendeddefs:=TFPHashObjectList.create(true);
-        symtablestack:=tdefawaresymtablestack.create;
-        if not assigned(specobj.genericdef) then
-          internalerror(200705151);
-        hmodule:=find_module_from_symtable(specobj.genericdef.owner);
-        if hmodule=nil then
-          internalerror(200705152);
-        { collect all unit syms in the generic's unit as we need to establish
-          their unitsym.module link again so that unit identifiers can be used }
-        unitsyms:=tfphashobjectlist.create(false);
-        if (hmodule<>current_module) and assigned(hmodule.globalsymtable) then
-          for i:=0 to hmodule.globalsymtable.symlist.count-1 do
-            begin
-              sym:=tsym(hmodule.globalsymtable.symlist[i]);
-              if sym.typ=unitsym then
-                unitsyms.add(upper(sym.realname),sym);
-            end;
-        pu:=tused_unit(hmodule.used_units.first);
-        while assigned(pu) do
-          begin
-            if not assigned(pu.u.globalsymtable) then
-              internalerror(200705153);
-            symtablestack.push(pu.u.globalsymtable);
-            sym:=tsym(unitsyms.find(pu.u.modulename^));
-            if assigned(sym) and not assigned(tunitsym(sym).module) then
-              tunitsym(sym).module:=pu.u;
-            pu:=tused_unit(pu.next);
-          end;
-        unitsyms.free;
-        if assigned(hmodule.globalsymtable) then
-          symtablestack.push(hmodule.globalsymtable);
-        if assigned(hmodule.localsymtable) then
-          symtablestack.push(hmodule.localsymtable);
+        specialization_init(specobj.genericdef,state);
 
         { procedure definitions for classes or objects }
         process_abstractrecorddef(specobj);
 
-        { Restore symtablestack }
-        current_module.extendeddefs.free;
-        current_module.extendeddefs:=oldextendeddefs;
-        symtablestack.free;
-        symtablestack:=oldsymtablestack;
+        specialization_done(state);
       end;